Remove non-terminating cycle from :gtm option

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -801,36 +801,35 @@
                                          (if (:autoconstructive-environments @push-argmap)
                                            [:integer :boolean :exec :float :tag :code :environment]
                                            [:integer :boolean :exec :float :tag :code]))]
-                                         (cycle
-                                           '(gtm_left
-                                              gtm_right
-                                              gtm_inc_delay
-                                              gtm_dec_delay
-                                              gtm_dub1
-                                              gtm_dub2
-                                              gtm_bounce1
-                                              gtm_bounce2
-                                              gtm_blank0
-                                              gtm_blank1
-                                              gtm_blank2
-                                              gtm_erase
-                                              gtm_read_all
-                                              gtm_write_all
-                                              gtm_read_instruction
-                                              gtm_write_instruction
-                                              gtm_read_silent
-                                              gtm_write_silent
-                                              gtm_read_close
-                                              gtm_write_close
-                                              autoconstructive_integer_rand
-                                              autoconstructive_boolean_rand
-                                              autoconstructive_code_rand_atom
-                                              genome_autoconstructing
-                                              genome_if_autoconstructing
-                                              exec_k_when_autoconstructing
-                                              exec_s_when_autoconstructing
-                                              exec_y_when_autoconstructing
-                                              ))))]
+                           '(gtm_left
+                              gtm_right
+                              gtm_inc_delay
+                              gtm_dec_delay
+                              gtm_dub1
+                              gtm_dub2
+                              gtm_bounce1
+                              gtm_bounce2
+                              gtm_blank0
+                              gtm_blank1
+                              gtm_blank2
+                              gtm_erase
+                              gtm_read_all
+                              gtm_write_all
+                              gtm_read_instruction
+                              gtm_write_instruction
+                              gtm_read_silent
+                              gtm_write_silent
+                              gtm_read_close
+                              gtm_write_close
+                              autoconstructive_integer_rand
+                              autoconstructive_boolean_rand
+                              autoconstructive_code_rand_atom
+                              genome_autoconstructing
+                              genome_if_autoconstructing
+                              exec_k_when_autoconstructing
+                              exec_s_when_autoconstructing
+                              exec_y_when_autoconstructing
+                              )))]
       (when true (not (some #{instr} (:atom-generators @push-argmap)))
         (swap! push-argmap assoc :atom-generators (conj (:atom-generators @push-argmap) instr))))
     ;;


recognize http_proxy env var, refs #2

recognize http_proxy env var, refs #2

--- src/tailrecursion/boot/loader.clj
+++ src/tailrecursion/boot/loader.clj
@@ -43,16 +43,45 @@
   [{type :type meth :method {name :name repo :repository} :resource err :error}]
   (when (.endsWith name ".jar")
     (case type
-      :started              (printf "Retrieving %s from %s\n" name repo)
+      :started              (printf "Retrieving %s from %s\n" name repo)
       (:corrupted :failed)  (when err (printf "Error: %s\n" (.getMessage err)))
       nil)
     (flush)))
+
+(defn ^:from-leiningen build-url
+  "Creates java.net.URL from string"
+  [url]
+  (try (URL. url)
+       (catch java.net.MalformedURLException _
+         (URL. (str "http://" url)))))
+
+(defn ^:from-leiningen get-non-proxy-hosts []
+  (let [system-no-proxy (System/getenv "no_proxy")]
+    (if (not-empty system-no-proxy)
+      (->> (str/split system-no-proxy #",")
+           (map #(str "*" %))
+           (str/join "|")))))
+
+(defn ^:from-leiningen get-proxy-settings
+  "Returns a map of the JVM proxy settings"
+  ([] (get-proxy-settings "http_proxy"))
+  ([key]
+     (if-let [proxy (System/getenv key)]
+       (let [url (build-url proxy)
+             user-info (.getUserInfo url)
+             [username password] (and user-info (.split user-info ":"))]
+         {:host            (.getHost url)
+          :port            (.getPort url)
+          :username        username
+          :password        password
+          :non-proxy-hosts (get-non-proxy-hosts)}))))

 (defn add-dependencies! [deps repos]
   (let [deps (mapv (partial exclude ['org.clojure/clojure]) deps)]
     (pom/add-dependencies :coordinates        deps
                           :repositories       (zipmap repos repos)
-                          :transfer-listener  transfer-listener)))
+                          :transfer-listener  transfer-listener
+                          :proxy              (get-proxy-settings))))

 (defn -main [& args]
   (let [cfg   (read-config (io/file "boot.edn"))


start reimplementing microscope

start reimplementing microscope

--- src/polismath/meta/microscope.clj
+++ src/polismath/meta/microscope.clj
@@ -1,17 +1,17 @@
-(ns polismath.meta.microscope)
-;  (:require [polismath.conv-man :as cm]
-;            [polismath.components.env :as env]
-;            [polismath.components.db :as db]
-;            [polismath.math.conversation :as conv]
-;            [polismath.math.named-matrix :as nm]
-;            [polismath.utils :as utils]
-;            [clojure.tools.trace :as tr]
-;            [clojure.tools.logging :as log]
-;            [clojure.newtools.cli :refer [parse-opts]]
-;            [com.stuartsierra.component :as component]
-;            [plumbing.core :as pc]
-;            [korma.core :as ko]
-;            [korma.db :as kdb]))
+(ns polismath.meta.microscope
+  (:require [polismath.conv-man :as cm]
+            [polismath.components.env :as env]
+            [polismath.components.postgres :as db]
+            [polismath.math.conversation :as conv]
+            [polismath.math.named-matrix :as nm]
+            [polismath.utils :as utils]
+            [clojure.tools.trace :as tr]
+            [clojure.tools.logging :as log]
+            [clojure.newtools.cli :refer [parse-opts]]
+            [com.stuartsierra.component :as component]
+            [plumbing.core :as pc]
+            [korma.core :as ko]
+            [korma.db :as kdb]))
 ;
 ;
 ;
@@ -23,30 +23,41 @@
 ;  (stop [this] this))
 ;
 ;;; XXX Should really move to db
-;(defn get-zid-from-zinvite
-;  [{:as microscope :keys [postgres]} zinvite]
-;  (->
-;    (kdb/with-db (:db-spec postgres)
-;      (ko/select "zinvites"
-;        (ko/fields :zid :zinvite)
-;        (ko/where {:zinvite zinvite})))
-;    first
-;    :zid))
-;
-;
-;(defn recompute
-;  [{:as microscope :keys [conversation-manager postgres]} & {:keys [zid zinvite recompute] :as args}]
-;  (assert (utils/xor zid zinvite))
-;  (let [zid        (or zid (get-zid-from-zinvite microscope zinvite))
-;        new-votes  (db/conv-poll postgres zid)]
-;    (println zid zinvite)
-;    (cm/queue-message-batch! conversation-manager :votes zid new-votes)
-;    (add-watch
-;      (:conv conv-actor)
-;      :complete-watch
-;      (fn [k r o n]
-;        (println "Done recomputing")))
-;    conv-actor))
+(defn get-zid-from-zinvite
+  [{:as system :keys [postgres]} zinvite]
+  (->
+    (kdb/with-db (:db-spec postgres)
+      (ko/select "zinvites"
+        (ko/fields :zid :zinvite)
+        (ko/where {:zinvite zinvite})))
+    first
+    :zid))
+
+(comment
+  (require '[polismath.runner :as runner :refer [system]])
+  (get-zid-from-zinvite system "7scufp")
+  :end-example-comment)
+
+
+(defn recompute
+  [{:as system :keys [conversation-manager postgres]} & {:keys [zid zinvite] :as args}]
+  (assert (utils/xor zid zinvite))
+  (let [zid        (or zid (get-zid-from-zinvite system zinvite))
+        new-votes  (db/conv-poll postgres zid 0)]
+    (log/info "Running a recompute on zid:" zid "(zinvite:" zinvite ")")
+    (cm/queue-message-batch! conversation-manager :votes zid new-votes)
+    (cm/add-listener!
+      conversation-manager
+      :complete-watch
+      (fn [new-conv]
+        (log/info "Done recomputing conv")))))
+
+(comment
+  (require '[polismath.runner :as runner :refer [system]])
+  (get-zid-from-zinvite system "7scufp")
+  (recompute system :zinvite "7scufp")
+  :end-example-comment)
+
 ;
 ;
 ;(defn kw->int


insights: separate out legend generation function

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -34,17 +34,85 @@
 (defn build-graphable [{:keys [outcome]}]
   (#{"success" "failed" "canceled"} outcome))

+(defn add-legend [svg {chart-width :width}]
+  (let [left-legend-array [{:classname "success"
+                            :text "Passed"}
+                           {:classname "failed"
+                            :text "Failed"}
+                           {:classname "canceled"
+                            :text "Canceled"}]
+        {:keys [square-size item-width item-height spacing]} {:square-size 10
+                                                              :item-width 80
+                                                              :item-height 14   ; assume font is 14px
+                                                              :spacing 4}
+        right-legend-array [{:classname "queue"
+                             :text "Queue time"}]
+        left-legend-item (-> svg
+                             (.selectAll ".legend")
+                             (.data (clj->js left-legend-array))
+                             (.enter)
+                             (.append "g")
+                             (.attr #js {"class" "legend left"
+                                         "transform"
+                                         (fn [item i]
+                                           (let [tr-x (* i item-width)
+                                                 tr-y (- (- item-height
+                                                            (/ (- item-height square-size)
+                                                               2)))]
+                                             (gstring/format "translate(%s,%s)" tr-x  tr-y)))}))
+        right-legend-item (-> svg
+                              (.selectAll ".legend-right")
+                              (.data (clj->js right-legend-array))
+                              (.enter)
+                              (.append "g")
+                              (.attr #js {"class" "legend right"
+                                          "transform"
+                                          (fn [item i]
+                                            (let [tr-x (- chart-width (* (inc i) item-width))
+                                                  tr-y (- (- item-height
+                                                             (/ (- item-height square-size)
+                                                                2)))]
+                                              (gstring/format "translate(%s,%s)" tr-x  tr-y)))}))]
+    ;; left legend
+    (-> left-legend-item
+        (.append "rect")
+        (.attr #js {"width" square-size
+                    "height" square-size
+                    "class" #(.-classname %)
+                    "transform"
+                    (fn [item i]
+                      (gstring/format "translate(%s,%s)" 0  (- (+ square-size))))}))
+    (-> left-legend-item
+        (.append "text")
+        (.attr #js {"x" (+ square-size spacing)})
+        (.text #(.-text %)))
+
+    ;; right legend
+    (-> right-legend-item
+        (.append "rect")
+        (.attr #js {"width" square-size
+                    "height" square-size
+                    "class" #(.-classname %)
+                    "transform"
+                    (fn [item i]
+                      (gstring/format "translate(%s,%s)" 0  (- (+ square-size))))}))
+    (-> right-legend-item
+        (.append "text")
+        (.attr #js {"x" (+ square-size
+                           spacing)})
+        (.text #(.-text %)))))
+
 (defn visualize-insights-bar! [elem builds]
   (let [y-max (apply max (mapcat #((juxt :queued_time_minutes :build_time_minutes) %)
                                  builds))
-        svg-width 900
-        svg-height 180
-        margins {:top 30, :right 10, :bottom 10, :left 70}
-        width (- svg-width (:left margins) (:right margins))
-        height (- svg-height (:top margins) (:bottom margins))
+        svg-info {:width 900
+                  :height 180
+                  :top 30, :right 10, :bottom 10, :left 70}
+        plot-info {:width (- (:width svg-info) (:left svg-info) (:right svg-info))
+                   :height (- (:height svg-info) (:top svg-info) (:bottom svg-info))}
         y-scale (-> (js/d3.scale.linear)
                     (.domain #js[(- y-max) y-max])
-                    (.range #js[height 0])
+                    (.range #js[(:height plot-info) 0])
                     (.nice))
         y-pos-scale (-> (js/d3.scale.linear)
                         (.domain #js[0 y-max])
@@ -52,7 +120,7 @@
                         (.nice))
         y-neg-scale (-> (js/d3.scale.linear)
                         (.domain #js[0 y-max])
-                        (.range #js[(y-scale 0) height])
+                        (.range #js[(y-scale 0) (:height plot-info)])
                         (.nice))
         y-middle (y-scale 0)
         y-tick-values (map js/Math.round
@@ -65,30 +133,17 @@
         x-scale (-> (js/d3.scale.ordinal)
                     (.domain (clj->js
                               (map :build_num builds)))
-                    (.rangeBands #js[0 width] 0.5))
-        legend-dimensions {:square-size 10
-                           :item-width 80
-                           :item-height 14   ; assume font is 14px
-                           :spacing 4
-                           }
-        left-legend [{:class_name "success"
-                      :text "Passed"}
-                     {:class_name "failed"
-                      :text "Failed"}
-                     {:class_name "canceled"
-                      :text "Canceled"}]
-        right-legend [{:class "queue"
-                      :text "Queue time"}]
+                    (.rangeBands #js[0 (:width plot-info)] 0.5))
         svg (-> js/d3
                 (.select elem)
                 (.html "")
                 (.append "svg")
-                (.attr "width" svg-width)
-                (.attr "height" svg-height)
+                (.attr "width" (:width svg-info))
+                (.attr "height" (:height svg-info))
                 (.append "g")
                 (.attr "transform" (gstring/format "translate(%s,%s)"
-                                                   (:left margins)
-                                                   (:top margins))))
+                                                   (:left svg-info)
+                                                   (:top svg-info))))
         enter (-> svg
                   (.selectAll "rect")
                   (.data (clj->js builds))
@@ -96,62 +151,9 @@
         grid-lines-container (-> svg
                                  (.append "g")
                                  (.attr "class" "grid-line horizontal"))]
+
     ;; legend
-    (let [{:keys [square-size item-width item-height spacing]} legend-dimensions
-          left-legend-item (-> svg
-                          (.selectAll ".legend")
-                          (.data (clj->js left-legend))
-                          (.enter)
-                          (.append "g")
-                          (.attr #js {"class" "legend left"
-                                      "transform"
-                                      (fn [item i]
-                                        (let [tr-x (* i item-width)
-                                              tr-y (- (- item-height
-                                                         (/ (- item-height square-size)
-                                                            2)))]
-                                          (gstring/format "translate(%s,%s)" tr-x  tr-y)))}))
-          right-legend-item (-> svg
-                          (.selectAll ".legend-right")
-                          (.data (clj->js right-legend))
-                          (.enter)
-                          (.append "g")
-                          (.attr #js {"class" "legend right"
-                                      "transform"
-                                      (fn [item i]
-                                        (let [tr-x (- width (* (inc i) item-width))
-                                              tr-y (- (- item-height
-                                                         (/ (- item-height square-size)
-                                                            2)))]
-                                          (gstring/format "translate(%s,%s)" tr-x  tr-y)))}))]
-      ;; left legend
-      (-> left-legend-item
-          (.append "rect")
-          (.attr #js {"width" square-size
-                      "height" square-size
-                      "class" #(.-class_name %)
-                      "transform"
-                      (fn [item i]
-                        (gstring/format "translate(%s,%s)" 0  (- (+ square-size))))}))
-      (-> left-legend-item
-          (.append "text")
-          (.attr #js {"x" (+ square-size spacing)})
-          (.text #(.-text %)))
-
-      ;; right legend
-      (-> right-legend-item
-          (.append "rect")
-          (.attr #js {"width" square-size
-                      "height" square-size
-                      "class" #(.-class_name %)
-                      "transform"
-                      (fn [item i]
-                        (gstring/format "translate(%s,%s)" 0  (- (+ square-size))))}))
-      (-> right-legend-item
-          (.append "text")
-          (.attr #js {"x" (+ square-size
-                             spacing)})
-          (.text #(.-text %))))
+    (add-legend svg plot-info)

     ;; y-axis
     (-> svg
@@ -167,7 +169,7 @@
                     "y1" (int y-middle)
                     "y2" (int y-middle)
                     "x1" 0
-                    "x2" width}))
+                    "x2" (:width plot-info)}))

     ;; horizontal grid-lines
     (doseq [tick (remove zero? y-tick-values)
@@ -178,7 +180,7 @@
                       "y1" y-pos
                       "y2" y-pos
                       "x1" 0
-                      "x2" width})))
+                      "x2" (:width plot-info)})))

     ;; positive bar
     (-> enter


(PDB-4257) queue: add a bit more metadata mangling documentation

--- src/puppetlabs/puppetdb/queue.clj
+++ src/puppetlabs/puppetdb/queue.clj
@@ -210,13 +210,17 @@
                                       tcoerce/from-long)
                  :version (Long/parseLong version)
                  :command (get md-cmd->pdb-cmd md-command "unknown")
-                 :certname certname
+                 :certname certid
                  :compression (if (seq compression) compression "")})))))))

 (def parse-metadata (metadata-parser))

 (def command-req-schema
-  "Represents an incoming command, before it has been enqueued"
+  "Represents an incoming command, before it has been enqueued.  One key
+  difference between this and the command ref (and a ref is what
+  you'll typically have) is that the certname in a ref may not be the
+  actual certname, it may be the mangled version which acts as a
+  hashable proxy for the original."
   {:command (apply s/enum (vals metadata-command->puppetdb-command))
    :version s/Int
    :certname s/Str
@@ -243,7 +247,12 @@
    :callback callback
    :command-stream command-stream})

-(defrecord CommandRef [id command version certname received producer-ts callback delete? compression])
+(defrecord CommandRef
+    ;; Note that the certname here is really a certid, i.e. it's what we
+    ;; store in the metadata for the certname which is either the actual
+    ;; certname with no trailing _HASH, or the sanitized and possibly
+    ;; truncated ADJUSTEDCERT_ORIGCERTHASH.
+    [id command version certname received producer-ts callback delete? compression])

 (defn cmdref->entry [{:keys [id received] :as cmdref}]
   (stock/entry id (serialize-metadata received cmdref true)))


CMR-1817: Added a test for unexpected granule ur in source granule for OMI/Aura virtual product

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -366,22 +366,24 @@
         data-path "http://acdisc.gsfc.nasa.gov/data/s4pa///Aura_OMI_Level3/OMUVBd.003/2013/"
         opendap-path "http://acdisc.gsfc.nasa.gov/opendap/HDF-EOS5//Aura_OMI_Level3/OMUVBd.003/2013/"]

-    (util/are2 [source-related-urls expected-related-url-maps]
+    (util/are2 [src-granule-ur source-related-urls expected-related-url-maps]
                (let [_ (d/ingest "GSFCS4PA" (dg/granule
-                                                     omi-coll {:granule-ur granule-ur
+                                                     omi-coll {:granule-ur src-granule-ur
                                                                :related-urls source-related-urls}))
                      _ (index/wait-until-indexed)
-                     virt-gran-umm (get-virtual-granule-umm granule-ur)
+                     virt-gran-umm (get-virtual-granule-umm src-granule-ur)
                      expected-related-urls (map #(umm-c/map->RelatedURL %) expected-related-url-maps)]
                  (= (set expected-related-urls) (set (:related-urls virt-gran-umm))))

                "Related urls with only one access url which matches the pattern"
+               granule-ur
                [{:url (str data-path ur-suffix) :type "GET DATA"}]
                [{:url (str opendap-path ur-suffix ".nc?ErythemalDailyDose,ErythemalDoseRate,UVindex")
                  :type "GET DATA"}]

                "Related urls with only one access url which matches the pattern, but is not
                an online access url"
+               granule-ur
                [{:url (str data-path ur-suffix)}]
                ;; Some additional attributes are added by CMR automatically, but url remains the same
                [{:url (str data-path ur-suffix)
@@ -389,14 +391,23 @@
                  :title "(USER SUPPORT)"}]

                "Related urls with only one access url which does not match the pattern"
+               granule-ur
                [{:url (str data-path "random.he5") :type "GET DATA"}]
                [{:url (str data-path "random.he5") :type "GET DATA"}]

                "Multiple related urls"
+               granule-ur
                [{:url (str data-path ur-suffix) :type "GET DATA"}
                 {:url "http://www.foo.com"}]
                [{:url (str opendap-path ur-suffix ".nc?ErythemalDailyDose,ErythemalDoseRate,UVindex")
                  :type "GET DATA"}
                 {:url "http://www.foo.com"
                  :type "VIEW RELATED INFORMATION"
-                 :title "(USER SUPPORT)"}])))
+                 :title "(USER SUPPORT)"}]
+
+               "Unexpected format for the granule UR should not result in translation"
+               "OMI-Aura_L3-OMUVBd_2004m1001_v003-2013m0314t081851.he5" ;; no ":"
+               [{:url (str data-path ur-suffix) :type "GET DATA"}]
+               [{:url (str data-path ur-suffix) :type "GET DATA"}])))
+
+


Remove deprecated test function.

Remove deprecated test function.

This has been tested much better by actual cues and graphterglow now.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -156,25 +156,6 @@
     (show/add-effect! :sparkle
                       (fun/sparkle (show/all-fixtures) :color sparkle-color-param
                                    :chance :sparkle-chance :fade-time :sparkle-fade))))
-
-(defn test-phases
-  "This is for testing the enhanced multi-beat and fractional-beat
-  phase calculations I am implementing; it should probably more
-  somewhere else, or just go away once there are example effects
-  successfully using these."
-  {:deprecated "0.1.1"}
-  ([]
-   (test-phases 20))
-  ([iterations]
-   (dotimes [n iterations]
-     (let [snap (rhythm/metro-snapshot (:metronome *show*))]
-       (println
-        (format "Beat %4d (phase %.3f) bar %4d (phase %.3f) 1:%.3f, 2:%.3f, 4:%.3f, 1/2:%.3f, 1/4:%.3f, 3/4:%.3f"
-                (:beat snap) (:beat-phase snap) (:bar snap) (:bar-phase snap)
-                (rhythm/snapshot-beat-phase snap 1) (rhythm/snapshot-beat-phase snap 2)
-                (rhythm/snapshot-beat-phase snap 4) (rhythm/snapshot-beat-phase snap 1/2)
-                (rhythm/snapshot-beat-phase snap 1/4) (rhythm/snapshot-beat-phase snap 3/4)))
-       (Thread/sleep 33)))))

 ;; Temporary for working on light aiming code


Tweak example layout.

Tweak example layout.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -45,11 +45,11 @@
 ;; fixtures and addresses that correspond to your actual hardware.
 (show/patch-fixture! :torrent-1 (blizzard/torrent-f3) 1 1 :x (tf/inches 49) :y (tf/inches 61.5) :z (tf/inches 6)
                      :y-rotation (tf/degrees -45))
-(show/patch-fixture! :hex-1 (chauvet/slimpar-hex3-irc) 1 129)
+(show/patch-fixture! :hex-1 (chauvet/slimpar-hex3-irc) 1 129 :y (tf/inches 4) :z (tf/inches 10))
 (show/patch-fixture! :blade-1 (blizzard/blade-rgbw) 1 270 :y (tf/inches 9))
 (show/patch-fixture! :blade-2 (blizzard/blade-rgbw) 1 240 :x (tf/inches 40) :y (tf/inches 58) :z (tf/inches -15)
                      :y-rotation (tf/degrees -45))
-(show/patch-fixture! :ws-1 (blizzard/weather-system) 1 161 :x 1.0 :y 1.5)
+(show/patch-fixture! :ws-1 (blizzard/weather-system) 1 161 :x (tf/inches 22) :y (tf/inches 7) :z (tf/inches 7))

 (defn global-color-cue
   "Make a color cue which affects all lights in the sample show. This


save corpus to file

save corpus to file

--- src/crawler/main.clj
+++ src/crawler/main.clj
@@ -10,7 +10,8 @@
             [crawler.rich-char-extractor :as rc-extractor]
             [crawler.structure-driven :as structure-driven]
             [crawler.utils :as utils]
-            [me.raynes.fs :as fs])
+            [me.raynes.fs :as fs]
+            (org.bovinegenius [exploding-fish :as uri]))
   (:use [clojure.pprint :only [pprint]]))

 (def crawler-options
@@ -228,30 +229,33 @@
                   (corpus/estimate-yield %
                                          pagination
                                          crawled-corpus))))
-         actions)]
-
-
-    (reduce
-     (fn [{budget-spent :budget-spent
-          corpus-downloaded :corpus} as]
-       (if (<= (- budget budget-spent)
-               0)
-         {:budget-spent budget-spent
-          :corpus corpus-downloaded}
-         (let [{corpus  :corpus
-                visited :visited}
-               (execute/execute-model-budget start-url
-                                             as
-                                             pagination
-                                             (- budget budget-spent)
-                                             [] ; no blacklist for now
-                                             corpus-downloaded)]
-           {:budget-spent (+ budget-spent (count visited))
-            :corpus (merge corpus corpus-downloaded)})))
-     {:budget-spent 0
-      :corpus {}}
-     planned-model)
-
+         actions)
+
+        final-corpus
+        (reduce
+         (fn [{budget-spent :budget-spent
+              corpus-downloaded :corpus} as]
+           (if (<= (- budget budget-spent)
+                   0)
+             {:budget-spent budget-spent
+              :corpus corpus-downloaded}
+             (let [{corpus  :corpus
+                    visited :visited}
+                   (execute/execute-model-budget start-url
+                                                 as
+                                                 pagination
+                                                 (- budget budget-spent)
+                                                 [] ; no blacklist for now
+                                                 corpus-downloaded)]
+               {:budget-spent (+ budget-spent (count visited))
+                :corpus (merge corpus corpus-downloaded)})))
+         {:budget-spent 0
+          :corpus {}}
+         planned-model)]
+    (let [date-file (str (utils/dated-filename (uri/host start-url) "")
+                         ".corpus")]
+      (with-open [corpus-wrtr (io/writer date-file)]
+        (pprint (:corpus final-corpus) corpus-wrtr)))
     ;; (reduce
     ;;  (fn [{budget-expended :budget-expended
     ;;       corpus :corpus}


Add wrap-with-pprint-{request,response} to dispatcher-spec

--- spec/rook/dispatcher_spec.clj
+++ spec/rook/dispatcher_spec.clj
@@ -27,6 +27,23 @@
   ([options context-pathvec ns-sym middleware]
      (dispatcher/compile-dispatch-table options
        (dispatcher/namespace-dispatch-table context-pathvec ns-sym middleware))))
+
+
+(defn wrap-with-pprint-request [handler]
+  (fn [request]
+    (dispatcher/pprint-code request)
+    (handler request)))
+
+(defn wrap-with-pprint-response [handler]
+  (fn [request]
+    (let [resp (handler request)]
+      (if (satisfies? clojure.core.async.impl.protocols/ReadPort resp)
+        (let [v (async/<!! resp)]
+          (async/>!! resp v)
+          (dispatcher/pprint-code v))
+        (dispatcher/pprint-code resp))
+      (prn)
+      resp)))

 (defn wrap-with-resolve-method [handler]


Remove console.log statements.

Remove console.log statements.

--- frontend/uxbox/ui/workspace/base.cljs
+++ frontend/uxbox/ui/workspace/base.cljs
@@ -92,14 +92,12 @@
 (defn- mouse-mixin-will-unmount
   [own]
   (let [key (::eventkey own)]
-    (js/console.log "mouse-mixin-will-unmount" key)
     (events/unlistenByKey key)
     (dissoc own ::eventkey)))

 (defn- mouse-mixin-transfer-state
   [old-own own]
   (let [key (::eventkey old-own)]
-    (js/console.log "mouse-mixin-transfer-state" key)
     (assoc own ::eventkey key)))

 (def ^:static mouse-mixin


add record counter

add record counter

--- src/fileape/core.clj
+++ src/fileape/core.clj
@@ -60,7 +60,7 @@
        (.getParent file) "/" (add-file-name-index
                               (clj-str/join "" (interpose "_" (-> (.getName file) (clj-str/split #"_") drop-last))) i))))

-  (defn ^Long record-count
+  (defn ^long record-count
     "Helper function for the file data to retreive the record count without needing to do type hinting to AtomicLong"
     [{:keys [^AtomicLong record-counter]}]
     (.get record-counter))


Test for function move-file

Test for function move-file

--- test/clj_fileutils/fileutils_test.clj
+++ test/clj_fileutils/fileutils_test.clj
@@ -196,3 +196,15 @@
         (is (nil? (slurp- "directory" "unknown.txt")))
         (is (nil? (slurp- "test" "unknown.txt")))))

+(deftest test-move-file
+    "Check the function clj-fileutils.fileutils/move-file."
+    (testing "Check the function clj-fileutils.fileutils/move-file"
+        (spit "test_file1" "test")
+        (is (.isFile (new-file "test_file1")))
+        (is (not (.isFile (new-file "test_file2"))))
+        (move-file "test_file1" "test_file2")
+        (is (not (.isFile (new-file "test_file1"))))
+        (is (.isFile (new-file "test_file2")))
+        (.delete (new-file "test_file1"))
+        (.delete (new-file "test_file2"))))
+


add example of what shows up in system

add example of what shows up in system

--- src/gangway/util.clj
+++ src/gangway/util.clj
@@ -13,6 +13,17 @@
           :worker (partial gangway.worker/do-work attache)}
      :out {:name (str "queue.out." n)
            :worker (partial gangway.disembark/disembark! attache)}}))
+
+;; example of structure in system
+#_
+{:showevidence {:in {:name "queue.in.showevidence"
+                     :worker gangway.worker/do-work}
+                :out {:name "queue.out.showevidence"
+                      :worker gangway.disembark/disembark!}}
+ :moodle {:in {:name "queue.in.moodle"
+               :worker gangway.worker/do-work}
+          :out {:name "queue.out.moodle"
+                :worker gangway.disembark/disembark!}}}

 ;; TODO: handle exceptions
 (defn start-queues! [system]


Basic login/logout without DB

Basic login/logout without DB

--- src/httpkit/core.clj
+++ src/httpkit/core.clj
@@ -2,6 +2,9 @@
   (:require [org.httpkit.server :refer [run-server]])
   (:require [clojure.tools.logging :refer [info error]])
   (:require [ring.middleware.reload :as reload]
+            [ring.middleware.session :as session]
+            [ring.util.response :refer [response redirect]]
+            [compojure.response :refer [render]]
             [compojure.core :refer [defroutes GET POST]]
             [compojure.route :as route :refer [resources files not-found]]
             [compojure.handler :refer [site]] ; form, query params decode; cookie; session, etc
@@ -10,37 +13,54 @@

 (defn- authenticate
   "Looks in user storage for a user record with the supplied credentials. If found returns true, else false."
-  [username password]
-  (and (= username "noam")
-       (= password "1234"))
+  [credentials]
+  (and (= (first credentials) "noam")
+       (= (second credentials) "1234"))
   )

-(defn show-landing-page [req]
-  {:status  200
-   :headers {"Content-Type" "application/json"}
-   :body    (json/generate-string {:foo "bar" :baz 5})})
+(defn- not-authenticated
+  []
+  {:status 403
+   :headers {}
+   :body "wrong credentials!" })

-(defn create-login [{params :form-params}]
+(defn- logged-in?
+  "Takes a session map and inspects it for the required keys to be logged in.
+   Returns true if logged in, else false."
+  [session]
+  (not (nil? (session :user-id))))
+
+(defn main-page [{session :session :as req}]
+  (if (logged-in? session)
+    (render "Welcome! Logout" req)
+    (redirect "/login.html"))
+  )
+
+(defn create-login [{session :session params :form-params}]
   (info params)
-  (if (authenticate (params "username") (params "password"))
-    {:status  200
-     :headers {"Content-Type" "text/html"}
-     :body    (str "you posted login! params: " params) }
-    {:status 403
-     :headers {}
-     :body "wrong credentials!" }))
+  (if (authenticate [(params "username") (params "password")]) ;; TODO: sanitize user data?
+    (let [session (assoc session :user-id 1)]
+      (-> (redirect "/")
+          (assoc :session session)))
+    (not-authenticated)))
+
+(defn logout
+  [req]
+  (-> (redirect "/")
+      (assoc :session nil)))

 (defn wrap-logging [handler]
   (fn [req]
-    (info "***REQUEST STARTED***" \newline req)
+    (info "=== REQUEST STARTED ===>" \newline req)
     (let [resp (handler req)]
       (info "Sent Response: " \newline resp)
-      (info "---REQUEST ENDED---" \newline)
+      (info "<=== REQUEST ENDED ===" \newline)
       resp)))
-1
+
 (defroutes all-routes
-  (GET "/" [] show-landing-page)
+  (GET "/" [] main-page)
   (POST "/login" [] create-login)
+  (GET "/logout" [] logout)
   (route/files "/") ;; static file url prefix /, in `public` folder
   (route/not-found "
Page not found.
")) ;; all other, return 404

@@ -55,10 +75,11 @@
   ;;(alter-var-root #'*read-eval* (constantly false))
   (info "starting up ...")
   (info "args: " args)
-  (let [dev-mode (in-dev? args) handler (if dev-mode
-                                          (reload/wrap-reload (site #'all-routes)) ;; only reload when dev
-                                          (site all-routes))]
+  (let [dev-mode (in-dev? args)
+        handler (if dev-mode
+                  (reload/wrap-reload (site #'all-routes)) ;; only reload when dev
+                  (site all-routes))]
     (if dev-mode
       (info "--- DEV MODE ---")
-      (info "PROD MODE"))
-    (run-server (-> handler wrap-logging) {:port 8080})))
+      (info "%%% PROD MODE %%%"))
+    (run-server (-> handler session/wrap-session wrap-logging) {:port 8080})))


fade in and out progress bar

fade in and out progress bar

--- src/cljs/infinitelives/pixi/resources.cljs
+++ src/cljs/infinitelives/pixi/resources.cljs
@@ -169,7 +169,7 @@
     (go
       ;; fade in
       (log "fade in")
-      (<! (sprite/fadein b :duration fade-in))
+      (<! (fadein b :duration fade-in))
       (log "done")

       ;; show load progress
@@ -182,7 +182,7 @@
       (<! (timeout 300))

       ;; fadeout
-      (<! (sprite/fadeout b :duration fade-out))
+      (<! (fadeout b :duration fade-out))

       ;; remove progress bar sprite
       (.removeChild s b)


fix description a bit

fix description a bit

--- src/cljs/reader_web_app/pages/landing.cljs
+++ src/cljs/reader_web_app/pages/landing.cljs
@@ -37,13 +37,7 @@
               " is the best place to just pick up a book, start reading and continue on any device even you are offline.")
             (dom/p #js {:className "welcome-dropzone-description"} "Drop your book anywhere on this page to start reading.")
             (dom/i #js {:className "fa fa-plus-square-o drop-icon"}
-              (om/build adding-book/adding-book []))
-            (dom/p #js {:className "welcome-show-library"}
-              "Or "
-              (dom/a #js {:className "sl-link-btn"}
-                (dom/i #js {:className "fa fa-search"} "")
-                "search library")
-              " collected by other readers.")))))))
+              (om/build adding-book/adding-book []))))))))

 (defn landing-page [data owner]
   (reify


fix node info

fix node info

--- src/cljs/swarmpit/component/node/info.cljs
+++ src/cljs/swarmpit/component/node/info.cljs
@@ -10,7 +10,7 @@
             [swarmpit.component.progress :as progress]
             [swarmpit.component.task.list :as tasks]
             [swarmpit.component.dialog :as dialog]
-            [swarmpit.component.menu :as menu]
+            [swarmpit.component.toolbar :as toolbar]
             [swarmpit.component.common :as common]
             [swarmpit.storage :as storage]
             [swarmpit.url :refer [dispatch!]]
@@ -25,8 +25,8 @@

 (defn- node-item-state [value]
   (case value
-    "ready" (label/green value)
-    "down" (label/red value)))
+    "ready" (label/header value "green")
+    "down" (label/header value "red")))

 (defn- me-handler
   [node-id]
@@ -90,26 +90,29 @@
                      (str "Node detach failed. " (:error response))))}))

 (defn form-pin-action
-  [id pinned?]
+  [id pinned? group?]
   (if pinned?
     {:onClick #(detach-node-handler id)
      :icon    (comp/svg icon/pin-path)
-     :more    true
-     :name    "Detach node"}
+     :group   group?
+     :name    "Detach"}
     {:onClick #(pin-node-handler id)
      :icon    (comp/svg icon/pin-path)
-     :more    true
-     :name    "Pin node"}))
+     :group   group?
+     :name    "Pin"}))

 (defn form-actions
   [id pinned?]
-  [(form-pin-action id pinned?)
+  [(form-pin-action id pinned? true)
    {:onClick #(dispatch! (routes/path-for-frontend :node-edit {:id id}))
     :icon    (comp/svg icon/edit-path)
-    :name    "Edit node"}
+    :main    true
+    :group   true
+    :name    "Edit"}
    {:onClick #(state/update-value [:open] true dialog/dialog-cursor)
     :icon    (comp/svg icon/trash-path)
-    :name    "Delete node"}])
+    :color   "secondary"
+    :name    "Delete"}])

 (rum/defc form-general < rum/static [node pinned?]
   (let [cpu (-> node :resources :cpu (int))
@@ -118,19 +121,15 @@
     (comp/card
       {:className "Swarmpit-form-card"}
       (comp/card-header
-        (merge
-          {:title     (:nodeName node)
-           :className "Swarmpit-form-card-header Swarmpit-card-header-responsive-title"
-           :subheader (:address node)}
-          (if (storage/admin?)
-            {:action (menu/menu
-                       (form-actions (:id node) pinned?)
-                       :nodeGeneralMenuAnchor
-                       :nodeGeneralMenuOpened)}
-            {:action (menu/menu
-                       [(form-pin-action (:id node) pinned?)]
-                       :nodeGeneralMenuAnchor
-                       :nodeGeneralMenuOpened)})))
+        {:title     (comp/typography {:variant "h6"} "Summary")
+         :subheader (form/item-labels
+                      [(node-item-state (:state node))
+                       (when (:leader node)
+                         (label/header "Leader" "primary"))
+                       (label/header (:role node) "info")
+                       (if (= "active" (:availability node))
+                         (label/header "active" "green")
+                         (label/header (:availability node) "info"))])})
       (comp/card-content
         {:className "Swarmpit-table-card-content"}
         (html
@@ -149,24 +148,12 @@
               (get-in node [:stats :memory :usedPercentage])
               (str (humanize/filesize memory-bytes :binary false) " ram")
               "graph-memory")]]))
-      (comp/card-content
-        {}
-        (html [:span (str "docker engine " (:engine node)) " on " [(:os node) " " (:arch node)]]))
-      (comp/card-content
-        {}
-        (form/item-labels
-          [(node-item-state (:state node))
-           (when (:leader node)
-             (label/primary "Leader"))
-           (label/grey (:role node))
-           (if (= "active" (:availability node))
-             (label/green "active")
-             (label/grey (:availability node)))]))
-      (comp/divider
-        {})
-      (comp/card-content
-        {:style {:paddingBottom "16px"}}
-        (form/item-id (:id node))))))
+      (form/item-main "ID" (:id node) false)
+      (form/item-main "Name" (:nodeName node))
+      (form/item-main "Address" (:address node))
+      (form/item-main "Engine" (:engine node))
+      (form/item-main "OS" (:os node))
+      (form/item-main "Arch" (:arch node)))))

 (def render-labels-metadata
   {:primary   (fn [item] (:name item))
@@ -278,7 +265,10 @@
          #(delete-node-handler id)
          "Delete node?"
          "Delete")
-       [:div.Swarmpit-form-context
+       [:div.Swarmpit-form-toolbar
+        (toolbar/toolbar "Node" id (if (storage/admin?)
+                                     (form-actions id pinned?)
+                                     [(form-pin-action id pinned? false)]))
         (comp/hidden
           {:xsDown         true
            :implementation "js"}


do not show disk info on node info page if agent down or stats unknown

--- src/cljs/swarmpit/component/node/info.cljs
+++ src/cljs/swarmpit/component/node/info.cljs
@@ -21,9 +21,11 @@
   (let [cpu (-> node :resources :cpu (int))
         memory-bytes (-> node :resources :memory (* 1024 1024))
         disk-bytes (-> node :stats :disk :total)]
-    (str cpu " " (clojure.contrib.inflect/pluralize-noun cpu "core") ", "
-         (humanize/filesize memory-bytes :binary false) " memory, "
-         (humanize/filesize disk-bytes :binary false) " disk")))
+    (let [core-stats (str cpu " " (clojure.contrib.inflect/pluralize-noun cpu "core") ", "
+                          (humanize/filesize memory-bytes :binary false) " memory")]
+      (if (some? disk-bytes)
+        (str core-stats ", " (humanize/filesize disk-bytes :binary false) " disk")
+        core-stats))))

 (defn- node-tasks-handler
   [node-id]


Add some structure and value checking.

Add some structure and value checking.

--- src/datomish/db.cljc
+++ src/datomish/db.cljc
@@ -353,6 +353,31 @@
   (let [[op e a v tx] entity]
     [op e a v (or tx current-tx)]))

+(defn ensure-entity-form [[op e a v tx :as entity]]
+  (cond
+    (not (sequential? entity))
+    (raise "Bad entity " entity ", should be sequential at this point"
+           {:error :transact/bad-entity, :entity entity})
+
+    (not (contains? #{:db/add :db/retract} op))
+    (raise "Unrecognized operation " op " expected one of :db/add :db/retract at this point"
+           {:error :transact/bad-operation :entity entity })
+
+    (not e)
+    (raise "Bad entity: nil e in " entity
+           {:error :transact/bad-entity :entity entity })
+
+    (not a)
+    (raise "Bad entity: nil a in " entity
+           {:error :transact/bad-entity :entity entity })
+
+    (not v)
+    (raise "Bad entity: nil v in " entity
+           {:error :transact/bad-entity :entity entity })
+
+    true
+    entity))
+
 (defn preprocess [db report]
   {:pre [(db? db) (report? report)]}

@@ -374,6 +399,8 @@
       ;; to a list of vectors, like
       ;; [[:db/add e :attr value] [:db/add ref :reverse e]].
       (->> (explode-entities (schema db)))
+
+      (update :entities (partial map ensure-entity-form))

       ;; Replace idents with entids where possible.
       (update :entities (partial map (partial maybe-ident->entid db)))


add per-constituent surface-string calculation

--- src/babel/english/grammar.clj
+++ src/babel/english/grammar.clj
@@ -340,9 +340,7 @@
                    (unifyc h10
                            {:head {:phrasal false
                                    :synsem {:cat :sent-modifier}}
-                            :rule "s-modifier"})
-
-))
+                            :rule "s-modifier"})))

 (defn aux-is-head-feature [phrase]
   (cond (= :verb (get-in phrase '(:synsem :cat)))
@@ -458,6 +456,10 @@
                       [k filtered-v]))))
           ]
       {:name "small-plus-vp-pronoun"
+       :morph-walk-tree (fn [tree]
+                          (do
+                            (merge tree
+                                   (morph-walk-tree tree))))
        :language "en"
        :morph fo
        :grammar grammar
@@ -492,6 +494,10 @@
                     (if (not (empty? filtered-v))
                       [k filtered-v]))))]
       {:name "medium"
+       :morph-walk-tree (fn [tree]
+                          (do
+                            (merge tree
+                                   (morph-walk-tree tree))))
        :grammar grammar
        :morph fo
        :lexicon lexicon


fix parentheses typo

fix parentheses typo

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -189,9 +189,9 @@
                       :sem {:pred :cambiare}}} ;; TODO: add reflexive sense

    "chat" {:synsem {:cat :verb
-                    :english {:participle "chatting"
-                              :past "chatted"}
-                    :sem {:pred :chat}}}
+                    :sem {:pred :chat}}
+           :english {:participle "chatting"
+                     :past "chatted"}}

    "charge" {:synsem {:cat :verb
                       :sem {:pred :caricare}}}


play:object is human=false

play:object is human=false

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -907,13 +907,15 @@
             :synsem {:cat :verb
                      :sem {:pred :giocare
                            :subj {:human true}
-                           :obj {:games true}}}}
+                           :obj {:human false
+                                 :games true}}}}

            {:comment "We are talking about playing music or sounds."
             :synsem {:cat :verb
                      :sem {:pred :suonare
                            :subj {:human true}
-                           :obj {:music true}}}}]
+                           :obj {:human false
+                                 :music true}}}}]

    "prepare" (let [subject-semantics (ref {:human true})]
                {:synsem {:cat :verb


always uses port 8080 when port is not defined anywhere else

--- src/eatme/server.clj
+++ src/eatme/server.clj
@@ -9,8 +9,7 @@
   "used for starting the server in development mode from REPL"
   ([] (start-server (init-config :dev)))
   ([config]
-     (let [port (or (Integer. (get (System/getenv) "PORT" (config :eatme-port)))
-                    8080)
+     (let [port (Integer. (or (get (System/getenv) "PORT" (config :eatme-port)) 8080))
            server (ring-server/serve (handler/get-handler #'handler/app)
                                      {:port port
                                       :init handler/init


Fix tests on error after renaming

Fix tests on error after renaming

--- test/carambar/repository_test.clj
+++ test/carambar/repository_test.clj
@@ -6,7 +6,7 @@

 (fact "Add an entry in repo."
-  (add-entry {:artifactid "/path/test.jar" :classes []}) => (contains {:artifactid "/path/test.jar" :classes []}))
+  (add-entry! {:artifactid "/path/test.jar" :classes []}) => (contains {:artifactid "/path/test.jar" :classes []}))

 (fact "Convert filename to javaclas."
   (filename->javaclass "a/b/c/MyClass.class") => "a.b.c.MyClass")
@@ -47,8 +47,8 @@
 (with-state-changes
   [(before :facts (do
                     (reset! repo [])
-                    (add-entry {:artifactid "foo.jar" :classes ["com.foo.Bar" "com.foo.Baz"]})
-                    (add-entry {:artifactid "bar.jar" :classes ["com.bar.Bar" "com.bar.Buzz"]}))
+                    (add-entry! {:artifactid "foo.jar" :classes ["com.foo.Bar" "com.foo.Baz"]})
+                    (add-entry! {:artifactid "bar.jar" :classes ["com.bar.Bar" "com.bar.Buzz"]}))
            )]
   (fact "Find class by name should returns classes starts with name"
     (find-class "Baz") => ["com.foo.Baz"]
@@ -58,8 +58,8 @@
 (with-state-changes
   [(before :facts (do
                     (reset! repo [])
-                    (add-entry {:artifactid "foo.jar" :classes ["com.foo.Bar" "com.foo.Baz"]})
-                    (add-entry {:artifactid "bar.jar" :classes ["com.bar.Kix" "com.bar.Baz"]})))]
+                    (add-entry! {:artifactid "foo.jar" :classes ["com.foo.Bar" "com.foo.Baz"]})
+                    (add-entry! {:artifactid "bar.jar" :classes ["com.bar.Kix" "com.bar.Baz"]})))]
   (facts "Filter repository by predicate"
     (filter-repo-by :classes #(has-name? "Baz" %)) => ["com.foo.Baz" "com.bar.Baz"]
     (filter-repo-by :classes #(name-starts-with? "Ba" %)) => ["com.foo.Bar" "com.foo.Baz" "com.bar.Baz"]))


Docstring, formatting

Docstring, formatting

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -15,7 +15,9 @@
             [detritus.variants :as v]
             [version-clj.core :as semver]))

-(defn dispatch [config & more]
+(defn dispatch
+  "Common dispatch function for all the API multimethods"
+  [config & more]
   (v/tag config))

 ;; Datastore API impl' multimethods - listing & reading


Document write-docs-for-ns

Document write-docs-for-ns

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -166,7 +166,15 @@
   #{#'clojure.data/Diff})

 (defn write-docs-for-ns
-
+  "Function of a configuration and a Namespace which traverses the public vars
+  of that namespace, writing documentation for each var as specified by the
+  config.
+
+  FIXME: currently provides special handling for the case of documenting
+  clojure.core, so that \"special forms\" in core will be documented via the
+  write-docs-for-specials function. This behavior will change and be replaced
+  with fully fledged support for writing documentation for arbitrary non-def
+  symbols via an input datastructure."
   [config ns]
   (let [ns-vars (->> (ns-publics ns) vals (remove var-blacklist))
         macros  (filter macro? ns-vars)


Add migration id to each row in table.

Add migration id to each row in table.

--- src/cadence/views/user.clj
+++ src/cadence/views/user.clj
@@ -137,7 +137,7 @@
 (defhtml migration-row
   "Convert a modified migration map to a table row."
   [{:keys [id doc applied?]}]
-  [:tr
+  [:tr.migration {:id (str "migration-" id)}
    [:td.date (h (str (time-format/unparse
                          (:rfc822 time-format/formatters)
                          (time-coerce/from-long


Version 0.3.2

Version 0.3.2

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.3.2-SNAPSHOT"
+(defproject metlog-vault "0.3.2"
   :description "Repository for long term storage of series data."

   :license {:name "Eclipse Public License"


Some cosmetics for EL_gfp

Some cosmetics for EL_gfp

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

--- src/conexp/contrib/dl/languages/EL_gfp.clj
+++ src/conexp/contrib/dl/languages/EL_gfp.clj
@@ -79,25 +79,30 @@
             G-x-G (graph-product G_T_A G_T_B),
             T_2   (description-graph->tbox G-x-G),
             [new-tbox new-target] (uniquify-ttp (clarify-ttp (tidy-up-ttp (clarify-ttp [T_2, [A,B]]))))]
-        (recur (tbox-union tbox new-tbox) (conj (vec (drop 2 concepts)) new-target))))))
+        (recur (tbox-union tbox new-tbox)
+               (conj (vec (drop 2 concepts))
+                     new-target))))))

 (defn EL-gfp-msc
   "Returns the model based most specific concept of objects in model."
   [model objects]
-  (if-not (empty? objects)
+  (if (not-empty objects)
     (EL-gfp-lcs (model->tbox model) objects)
     (let [language (model-language model),
-	  all (make-dl-expression language
-				  (list* 'and
-					 (concat (concept-names language)
-						 (for [r (role-names language)]
-						   (list 'exists r 'All)))))]
+	  all      (make-dl-expression language
+                                       (list* 'and
+                                              (concat (concept-names language)
+                                                      (for [r (role-names language)]
+                                                        (list 'exists r 'All)))))]
       [(make-tbox language {'All (make-dl-definition 'All all)}), 'All])))

 (define-msc EL-gfp
   [model objects]
-  (let [[tbox target] (normalize-EL-gfp-term
-                       (reduce-ttp (tidy-up-ttp (clarify-ttp (EL-gfp-msc model objects)))))]
+  (let [[tbox target] (-> (EL-gfp-msc model objects)
+                          clarify-ttp
+                          tidy-up-ttp
+                          reduce-ttp
+                          normalize-EL-gfp-term)]
     (if (acyclic? tbox)
       (definition-expression (first (tbox-definitions tbox)))
       (make-dl-expression (model-language model) [tbox target]))))


Show md titles in toc

Show md titles in toc

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -95,12 +95,17 @@
     [:fo:basic-link {:internal-destination (hash path)}
      (inline {:role "Reference"}
              (when-let [numbers (get path-to-numbers path)] (section-numbers numbers))
-             (layout/translations (last path)))
+             (let [title (last path)]
+               (if (keyword? title) (layout/translations title) title)))
      " " [:fo:leader {:leader-pattern "dots" :role "NonStruct"}] " "
      [:fo:page-number-citation {:ref-id (hash path) :role "Reference"}]]
-    (when (and (map? items) (< current-depth depth))
+    (cond
+      (and (map? items) (< current-depth depth))
       (map #(toc-entry (get items %) (conj path %) path-to-numbers depth (inc current-depth))
-           (order (keys items))))]))
+           (order (keys items)))
+      (and (string? items) (not-empty (md-extract-headings items))) ; markdown
+      (map #(toc-entry % (conj path %) path-to-numbers depth (inc current-depth))
+           (md-extract-headings items)))]))

 (defn toc [items path depth path-to-numbers & {:keys [heading?]}]
   (when (map? items)


product-number is also LibrarySignature

product-number is also LibrarySignature

not just a s string

--- src/catalog/validation.clj
+++ src/catalog/validation.clj
@@ -37,7 +37,7 @@
     (s/optional-key :source) s/Str
     (s/optional-key :description) s/Str
     :library-signature LibrarySignature
-    (s/optional-key :product-number) s/Str
+    (s/optional-key :product-number) LibrarySignature
     (s/optional-key :price) s/Str
     (s/optional-key :accompanying_material) s/Str
     (s/optional-key :language) Language


extend the Context protocol to more Manifold types

SuccessDeferred and ErrorDeferred instances are
returned by success-deferred and error-deferred, but
are separate types from Deferred, so need the Context
protocol extending to them too

--- src/cats/labs/manifold.clj
+++ src/cats/labs/manifold.clj
@@ -76,3 +76,10 @@
   p/Context
   (-get-context [_] deferred-context))

+(extend-type manifold.deferred.SuccessDeferred
+  p/Context
+  (-get-context [_] deferred-context))
+
+(extend-type manifold.deferred.ErrorDeferred
+  p/Context
+  (-get-context [_] deferred-context))


(MAINT) Extract validate-regex-backreferences!

This commit extract the regex back-reference & capture group validation
code from validate-auth-config-rule! into its own function.

--- src/puppetlabs/trapperkeeper/services/authorization/authorization_core.clj
+++ src/puppetlabs/trapperkeeper/services/authorization/authorization_core.clj
@@ -92,6 +92,42 @@
       :else
       false)))

+(defn validate-regex-backreferences!
+  "Validates that allow and deny back-references actually exist as capture
+   groups in the path regex. Throws an exception if a back-reference refers
+   to a capture group that doesn't exist."
+  [rule]
+  (let [group-count (try
+                      (-> rule
+                          :match-request
+                          :path
+                          re-pattern
+                          (.matcher "")
+                          .groupCount)
+                      (catch PatternSyntaxException e
+                        (throw (IllegalArgumentException.
+                                (str "The path regex provided in the rule"
+                                     " defined as " (pprint-rule rule)
+                                     " is invalid: " (.getMessage e))))))
+        get-br-list (fn [match-str]
+                      (map #(Integer/parseInt (second %))
+                           (re-seq #"\$(\d+)" match-str)))
+        largest-br (fn [match]
+                     (let [br-list (mapcat get-br-list
+                                           (flatten [(or match "")]))]
+                       (when (> (count br-list) 0)
+                         (apply max br-list))))
+        largest-allow-br (or (largest-br (:allow rule)) 0)
+        largest-deny-br (or (largest-br (:deny rule)) 0)]
+    (doseq [[largest field] [[largest-allow-br "allow"]
+                             [largest-deny-br "deny"]]
+            :when (> largest group-count)]
+      (throw (IllegalArgumentException.
+              (str "The " field " field provided in the rule specified as "
+                   (pprint-rule rule) " contains the back reference '$"
+                   largest "' which refers to a capture group in "
+                   "the regex that doesn't exist."))))))
+
 (defn validate-auth-config-rule!
   "Tests to see if the given map contains the proper data to define an auth
   rule. Returns the provided rule if successful, otherwise throws an exception
@@ -153,32 +189,7 @@
                  "equal to one of the following methods: '"
                  (str/join "', '" (sort valid-methods)) "'"))))
   (when (= "regex" (-> rule :match-request :type name str/lower-case))
-    (try
-      (let [pattern (re-pattern (:path (:match-request rule)))
-            group-count (-> pattern (.matcher "") .groupCount)
-            get-br-list (fn [match-str]
-                          (map #(Integer/parseInt (nth % 1))
-                               (re-seq #"\$(\d+)" match-str)))
-            largest-br (fn [match]
-                         (let [br-list (flatten (map get-br-list
-                                                     (flatten [(or match "")])))]
-                           (when (> (count br-list) 0)
-                             (apply max br-list))))
-            largest-allow-br (or (largest-br (:allow rule)) 0)
-            largest-deny-br (or (largest-br (:deny rule)) 0)]
-        (doseq [[largest field] [[largest-allow-br "allow"]
-                                 [largest-deny-br "deny"]]]
-          (if (> largest group-count)
-            (throw (IllegalArgumentException.
-                     (str "The " field " field provided in the rule specified as "
-                          (pprint-rule rule) " contains the back reference '$"
-                          largest "' which refers to a capture group in "
-                          "the regex that doesn't exist."))))))
-      (catch PatternSyntaxException e
-        (throw (IllegalArgumentException.
-                 (str "The path regex provided in the rule defined as "
-                      (pprint-rule rule) " is invalid: "
-                      (.getMessage e)))))))
+    (validate-regex-backreferences! rule))
   (doseq [[type names] (select-keys rule [:allow :deny])]
     (if (vector? names)
       (when-not (every? string? names)


Fix vars whose names are substrings of other var names

--- src/icfp2014/ghc.clj
+++ src/icfp2014/ghc.clj
@@ -60,15 +60,18 @@
               (-> (s/replace l
                              (str "$" var)
                              (str "[" idx "]"))
-                  (str (format " ; $%s = %d" var idx)))))
+                  (str (format " ; %s=%d" var idx)))))
           line
-          (vars line)))
+          (-> line
+              vars
+              sort
+              reverse)))

 (defn var-lines
   [seq-of-lines]
   (let [source  (->> seq-of-lines
                      (filter (complement comment?)))
-        var-lst (vec (mapcat vars source))]
+        var-lst (vec (set (mapcat vars source)))]
     (if (> (count var-lst) 255)
       (throw (IllegalArgumentException. "The number of variables is too damn high!")))
     (mapv (partial replace-vars var-lst) source)))


improve logging and diagnostics

improve logging and diagnostics

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -144,20 +144,20 @@
     (if (seq candidate-heads)
       (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
             (mapcat (fn [parent]
-                      (let [head-is-phrasal (get-in parent [:head :phrasal] false)
-                            candidate-lexemes (if (not (= true head-is-phrasal))
-                                                (get-lex parent :head index spec))]
-                        (log/debug
-                         (str "candidate head lexemes for parent phrase "
-                              (get-in parent [:rule]) ": "
-                              (string/join ","
-                                           (map (fn [lexeme]
-                                                  (morph lexeme))
-                                                candidate-lexemes))))
-                        (let [result
-                              (if (empty? candidate-lexemes)
-                                (if (= true head-is-phrasal)
-                                  (log/debug (str "no head lexemes possible because spec requires a phrasal head."))
+                      (if (= false (get-in parent [:head :phrasal] false))
+                        (let [candidate-lexemes (get-lex parent :head index spec)]
+                          (log/error (str "candidate lexemes for: " (get-in parent [:rule]) ":" (count candidate-lexemes)))
+                          (if (some fail? candidate-lexemes)
+                            (throw (exception (str "some candidate lexeme was fail?=true!"))))
+                          (log/debug
+                           (str "candidate head lexemes for parent phrase "
+                                (get-in parent [:rule]) ": "
+                                (string/join ","
+                                             (map (fn [lexeme]
+                                                    (morph lexeme))
+                                                  candidate-lexemes))))
+                          (let [result
+                                (if (empty? candidate-lexemes)
                                   (log/warn (str "no head lexemes found for parent: " (:rule parent) " and spec: "
                                                  (strip-refs spec)))
                                   (over/overh parent


add collector

add collector

--- src/clj/hsm/views.clj
+++ src/clj/hsm/views.clj
@@ -167,6 +167,7 @@
             "Running version  " [:a {:href (str "https://github.com/bcambel/hackersome/commit/" VERSION)} (str "@" SHORTVERSION)]]
           [:p "Code licensed under " [:a {:href "https://github.com/bcambel/hackersome/blob/development/LICENSE"} :MIT]]
           [:hr]
+          (when-not is-dev?
           [:p
             [:a.twitter-share-button {:href "https://twitter.com/share"
               :data-text "Top Projects on"
@@ -177,7 +178,7 @@
           [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=pythonhackers&type=watch&count=true&size=normal"
                     :allowtransparency true :frameborder 0 :scroling 0 :width "120px" :height "30px"}]
           [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=hackersome&type=watch&count=true&size=normal"
-                    :allowtransparency true :frameborder 0 :scroling 0 :width "260px" :height "30px"}]
+                    :allowtransparency true :frameborder 0 :scroling 0 :width "260px" :height "30px"}])
             ]
          ]
         [:div#mc_embed_signup.modal.fade
@@ -213,19 +214,23 @@
       })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
       ga('create', '%s', 'auto');
       ga('send', 'pageview');" property-id)
-
+
           "!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document, 'script', 'twitter-wjs');"
+          (when-not is-dev?
           (format
           "(function() {
             var dsq = document.createElement('script'); dsq.type = 'text/javascript'; dsq.async = true;
             dsq.src = '//%s.disqus.com/embed.js';
             (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(dsq);
-        })();" (or (get disqus-ids website) "hackersome"))
+        })();" (or (get disqus-ids website) "hackersome")))
 (when-not is-dev?
 "!function(){var analytics=window.analytics=window.analytics||[];if(!analytics.initialize)if(analytics.invoked)window.console&&console.error&&console.error('Segment snippet included twice.');else{analytics.invoked=!0;analytics.methods=['trackSubmit','trackClick','trackLink','trackForm','pageview','identify','group','track','ready','alias','page','once','off','on'];analytics.factory=function(t){return function(){var e=Array.prototype.slice.call(arguments);e.unshift(t);analytics.push(e);return analytics}};for(var t=0;t<analytics.methods.length;t++){var e=analytics.methods[t];analytics[e]=analytics.factory(e)}analytics.load=function(t){var e=document.createElement('script');e.type='text/javascript';e.async=!0;e.src=('https:'===document.location.protocol?'https://':'http://')+'cdn.segment.com/analytics.js/v1/'+t+'/analytics.min.js';var n=document.getElementsByTagName('script')[0];n.parentNode.insertBefore(e,n)};analytics.SNIPPET_VERSION='3.0.1';
   analytics.load('eqMNHeqB0Ukx8AWah4nKiwFwaxbeJlGg');
   analytics.page();}}();
 ")
+(format`
+"window.jstag=function(e){var t=!1,n=window,r=document,i='/js/io',s=Array.prototype.slice,o=e.url||'';return n.jstag||{load:function(){var e,s=r.getElementsByTagName('script')[0];return t=!0,'JSON'in n&&Array.prototype.forEach||(i+='w'),r.getElementById(i)?this:(e=r.createElement('script'),e.id=i,e.src=o+i+'.min.js',s.parentNode.insertBefore(e,s),this)},_q:[],_c:e,bind:function(e){this._q.push([e,s.call(arguments,1)])},ready:function(){this._q.push(['ready',s.call(arguments)])},send:function(){return t||this.load(),this._q.push(['ready','send',s.call(arguments)]),this},ts:(new Date).getTime()}
+}({cid:'report',url:'//%s/',path:'',idpath:''});" (if is-dev? "dev.strck.hackersome.com" "strck.hackersome.com"))
           )
         ])
     [:img {:src "http://strck.hackersome.com/pixel.gif" :alt ""}]])))


Add win64 support in the code

Add win64 support in the code

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -9,6 +9,9 @@
         os-name (. (System/getProperty "os.name") toLowerCase)]
     (cond (and (.startsWith os-name "win") (= "x86" os-arch))
           (str "win-x86/" s ".dll")
+
+          (and (.startsWith os-name "win") (= "x64" os-arch))
+          (str "win-x86_64/" s ".dll")

           (and (.startsWith os-name "mac")) ; assume all macs are 64bits
           (str "macosx/" s ".dylib")


Use cider/cider-nrepl 0.10.0-SNAPSHOT

Use cider/cider-nrepl 0.10.0-SNAPSHOT

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -10,7 +10,7 @@
                        [org.clojure/tools.nrepl "0.2.7"]
                        [slamhound "1.5.3"]]

-        :plugins [[cider/cider-nrepl "0.9.1-SNAPSHOT"]
+        :plugins [[cider/cider-nrepl "0.10.0-SNAPSHOT"]
                   [codox "0.6.6"]
                   [jonase/eastwood "0.2.1"]
                   [lein-clojars "0.9.1"]


write fn writes appropriate content for different types.

--- src/isla/library.clj
+++ src/isla/library.clj
@@ -11,9 +11,12 @@
   (def isla-ctx
     {
      ;; fns
-     "write" (fn [env str]
-               (story-utils/output str) ;; print out
-               str) ;; add to context
+     "write" (fn [env param]
+               (let [result (cond (map? param) (str "a " (:type (meta param)))
+                                  (set? param) (apply str (interpose "\n" param))
+                                  :default     param)]
+                 (story-utils/output result)
+                 result)) ;; add to context

      ;; types


proof script evaluator written, missing subroutines and ... testing

--- src/latte/script.clj
+++ src/latte/script.clj
@@ -103,3 +103,48 @@
           :have-name name}]
     [:ok (dissoc def-env name) ctx]))

+
+(defn evaluate-script [script start-def-env start-ctx def-env ctx cont-stack]
+  (if (seq script)
+    (case (first script)
+      assume
+      (let [[status info] (parse-assume-step script)]
+        (if (= status :ko)
+          [:ko info]
+          (let [{[x ty] :binding body :body} info]
+            (let [[status res] (do-assume def-env ctx x ty)]
+              (if (= status :ko)
+                [:ko res]
+                (recur body start-def-env start-ctx
+                       (first res) (second res) (conj cont-stack (list 'undo-assume x))))))))
+      undo-assume
+      (let [[status res] (undo-assume def-env ctx (second script))]
+        (if (= status :ko)
+          [:ko res]
+          (recur '() start-def-env start-ctx (first res) (second res) cont-stack)))
+      have
+      (let [[status info] (parse-have-step script)]
+        (if (= status :ko)
+          [:ko info]
+          (let [{have-name :have-name params :params
+                 have-type :have-type method :method have-arg :have-arg
+                 body :body} info]
+            (let [[status res] (do-have def-env ctx have-name params have-type method have-arg)]
+              (if (= status :ko)
+                [:ko res]
+                (recur body start-def-env start-ctx (first res) (second res)
+                       (conj cont-stack (list 'undo-have have-name))))))))
+      undo-have
+      (let [[status res] (undo-have def-env ctx (second script))]
+        (if (= status :ko)
+          [:ko res]
+          (recur '() start-def-env start-ctx (first res) (second res) cont-stack)))
+      qed
+      (do-qed start-def-env start-ctx (second script))
+      ;; else
+      (throw (ex-info "Cannot evaluate script" {:script script})))
+    ;; at end of script
+    (if (seq cont-stack)
+      (recur (first cont-stack) start-def-env start-ctx def-env ctx (rest cont-stack))
+      [:ko {:msg "Missing `qed` step in proof."}])))
+


remove unnecessary investigations

remove unnecessary investigations

--- test/jarvis/jdbc/usecase_test.clj
+++ test/jarvis/jdbc/usecase_test.clj
@@ -1,44 +0,0 @@
-(ns jarvis.jdbc.usecase-test
-  (require [clojure.test :refer :all]
-           [jarvis.core :refer :all]
-           [clojure.java.jdbc :as jdbc]
-           [java-jdbc.ddl :as ddl]
-           [java-jdbc.sql :as sql]
-           [jarvis.event.core :refer :all])
-  (:import (java.sql SQLException)))
-
-(def db-spec {:classname   "org.postgresql.Driver"
-              :subprotocol "postgresql"
-              :subname     "//localhost:5432/jarvis-test"
-              :user        "postgres"
-              :password    "postgres"})
-
-(deftest a-test
-  (testing "FIXME, I fail not anymore..."
-    (try
-      (do
-        (jdbc/db-do-commands db-spec
-                             "DROP TABLE events"
-                             "CREATE TABLE events (
-                                stream_id character varying NOT NULL,
-                                version bigint NOT NULL,
-                                event character varying not null,
-                                CONSTRAINT pk PRIMARY KEY (stream_id, version))")
-        (jdbc/insert! db-spec :events
-                      nil                                   ; column names omitted
-                      ["id-1" 1 (pr-str {:type :created :when 17})]
-                      ["id-1" 2 (pr-str {:type :skills-added :when 18 :skills #{:java}})]
-                      ["id-1" 3 (pr-str {:type :skills-added :when 19 :skills #{:clojure :erlang}})]
-                      ["id-1" 4 (pr-str {:type :skills-removed :when 20 :skills #{:java}})])
-        (is (= [{:stream_id "id-1", :version 1, :event "{:type :created, :when 17}"}
-                {:stream_id "id-1", :version 2, :event "{:type :skills-added, :when 18, :skills #{:java}}"}
-                {:stream_id "id-1", :version 3, :event "{:type :skills-added, :when 19, :skills #{:clojure :erlang}}"}
-                {:stream_id "id-1", :version 4, :event "{:type :skills-removed, :when 20, :skills #{:java}}"}]
-               (jdbc/query db-spec
-                           (sql/select * :events
-                                       (sql/where {:stream_id "id-1"})
-                                       (sql/order-by :version))))))
-      (catch SQLException e (do
-                              (.printStackTrace e)
-                              (.printStackTrace
-                                (.getNextException e)))))))


tmp update

tmp update

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/clj/brains_brain/core.clj
+++ src/clj/brains_brain/core.clj
@@ -22,6 +22,54 @@
            (- board-size cell-size)))))

 (println (str "size: " size))
+
+(vec (repeat 9 0))
+
+(def a (vec (replicate 8 (vec (replicate 8 :off)))))
+
+(nth (nth a 1 ) 1)
+
+;; We can use clojure's `make-array' create 2d array, but we do our own here
+(defn make-array
+  [width height init-val]
+  (vec
+   (map vec
+       (partition width (repeat (* width height) init-val)))))
+
+(defn array-get
+  [arr i j]
+  (nth (nth arr i) j))
+
+(def a (make-array 8 4 :off))
+
+(def a (make-array 8 8 :off))
+
+(map vec a)
+(assoc [0 1 2] 1 5)
+
+(assoc (seq (nth a 3)) 2 2)
+
+(var-set '(1 2 3) 1 )
+
+(assoc a 0 (assoc (nth a 1) 0 1))
+
+(array-get a 1 1)
+
+(defn arr-set
+  [arr i j val]
+  (nth arr i)
+  )
+
+(for [y (range 8) x (range 8)] :off );; {:x x :y y})
+;;(partition  8 (for [y (range 8) x (range 8)] {:x x :y y}))
+(nth (partition 5 (repeat 25 0)) 1 )
+
+
+(nth (nth a 0) 1)
+
+(assoc a)
+
+(arr-get a 1 1)

 ;; TODO: this function need a little modify to run on cljs
 (defn make-board


Better codox

Better codox

--- src/clj/datasplash/pubsub.clj
+++ src/clj/datasplash/pubsub.clj
@@ -7,38 +7,42 @@
            (java.nio.charset StandardCharsets)))

-(def message-types
+(def ^:no-doc message-types
   {:read {:raw (PubsubIO/readMessagesWithAttributes)
           :string (PubsubIO/readStrings)}
    :write {:raw (PubsubIO/writeMessages)
            :string (PubsubIO/writeStrings)}})

-(defn pubsub-message->clj
+(defn ^:no-doc pubsub-message->clj
   "Converts a pubsub message to a clojure usable object. Assumes the payload is UTF-8 encoded"
   [^PubsubMessage m]
   {:payload (String. (.getPayload m) "UTF-8")
    :attributes (into {} (.getAttributeMap m))})

-(defn clj->pubsub-message
+(defn ^:no-doc clj->pubsub-message
   "Converts a clojure map containing a payload and an attributes keys. payload must be a string and attributes a map"
   [{:keys [payload attributes]}]
   (let [attributes-map (into {} (map (fn [k v] [(if (keyword? k) (name k) (str k)) (str v)]) attributes))]
     (PubsubMessage. (.getBytes payload StandardCharsets/UTF_8) attributes-map)))

 (defn encode-messages
-  "Converts the input to PubsubMessages. To use before `write-to-pubsub` with type `:raw`"
+  "Converts the input to PubsubMessages. To use before `write-to-pubsub` with type `:raw`.
+
+  Takes as input a map with a `:payload` key and an `:attributes` key, assumes the payload is UTF-8 encoded"
   [options p]
   (dmap clj->pubsub-message (assoc options :coder (PubsubMessageWithAttributesCoder/of)) p))

 (defn decode-messages
-  "Converts the input PubsubMessages to clojure objects. To use after `read-from-pubsub` with type `:raw`"
+  "Converts the input PubsubMessages to clojure objects. To use after `read-from-pubsub` with type `:raw`.
+
+  Returns an map with a `:payload` key and an `:attributes` key, assumes the payload is UTF-8 encoded"
   [options p]
   (dmap pubsub-message->clj options p))

-(def read-from-pubsub-schema
+(def ^:no-doc read-from-pubsub-schema
   (merge
    named-schema
-   {:kind {:docstr "Specifies if the input is a `:subscription` or a `:topic` (default to :topic)."}
+   {:kind {:docstr "Specifies if the input is a `:subscription` or a `:topic` (default to `:topic`)."}
     :type {:docstr "Specify the type of message reader, default to `:string.` Possible values are `:string`: UTF-8 encoded strings, `:raw`: pubsub message with attributes."}
     :timestamp-label {:docstr "Set the timestamp of the message using a message's attribute. The attribute should contain an Unix epoch in milliseconds."}}))

@@ -71,7 +75,7 @@
      (apply-transform pipe pubsub-read read-from-pubsub-schema options)))
   ([subscription-or-topic p] (read-from-pubsub subscription-or-topic {} p)))

-(def write-from-pubsub-schema
+(def ^:no-doc write-from-pubsub-schema
   (merge
    named-schema
    {:type {:docstr "Specify the type of message writer, default to `:string.` Possible values are `:string`: UTF-8 encoded strings, `:raw`: raw pubsub message."}}))


condensed running total function code down into fewer jobs.

--- src/clj/forma/source/fire.clj
+++ src/clj/forma/source/fire.clj
@@ -119,7 +119,7 @@

 ;; Combines various fire tuples into one.
-(defaggregateop combine
+(defaggregateop comb
   ([] (FireTuple. 0 0 0 0))
   ([state tuple] (add-fires state tuple))
   ([state] [state]))
@@ -131,17 +131,37 @@
   (<- [?dataset ?m-res ?new-t-res ?tilestring ?tperiod ?sample ?line ?newtuple]
       (datetime->period ?new-t-res ?datestring :> ?tperiod)
       (identity t-res :> ?new-t-res)
-      (combine ?tuple :> ?newtuple)
+      (comb ?tuple :> ?newtuple)
       (src ?dataset ?m-res ?t-res ?tilestring ?datestring ?sample ?line ?tuple)))
+
+(defn running-sum
+  "Given an accumulator, an initial value and an addition function,
+  transforms the input sequence into a new sequence of equal length,
+  increasing for each value."
+  [acc init add-func tseries]
+  (first (reduce (fn [[coll last] new]
+                   (let [last (add-func last new)]
+                     [(conj coll last) last]))
+                 [acc init] tseries)))
+
+(defn running-fire-sum
+  "Special case of `running-sum` for `FireTuple` thrift objects."
+  [tseries]
+  (let [empty (FireTuple. 0 0 0 0)]
+    (->> (.getValues tseries)
+         (running-sum [] empty add-fires)
+         (mk-ts (.startPeriod tseries)
+                (.endPeriod tseries)))))

 (defn fire-series
   "Aggregates fires into timeseries."
   [t-res start end src]
   (let [empty (FireTuple. 0 0 0 0)]
-    (<- [?dataset ?m-res ?t-res ?tilestring ?tperiod ?sample ?line ?tseries]
+    (<- [?dataset ?m-res ?t-res ?tilestring ?sample ?line ?ct-series]
         (src ?dataset ?m-res ?t-res ?tilestring ?tperiod ?sample ?line ?tuple)
         (:sort ?tperiod)
-        (sparse-expansion [t-res start end empty] ?tperiod ?tuple :> ?tseries))))
+        (sparse-expansion [t-res start end empty] ?tperiod ?tuple :> ?tseries)
+        (running-fire-sum ?tseries :> ?ct-series))))

 (defn run-rip
   "Rips apart fires!"


Server no longer has to worry about pings

--- src/clj/retroboard/server.clj
+++ src/clj/retroboard/server.clj
@@ -30,5 +30,4 @@
                   (reload/wrap-reload web-handler)
                   web-handler)]
     (run-server handler {:port port})
-    (api.env/ping-clients)
     (println "Running on " port)))


Limit throw distance

Limit throw distance

--- src/cljc/robinson/update.cljc
+++ src/cljc/robinson/update.cljc
@@ -1857,27 +1857,32 @@

 (defn move-cursor
   [state direction]
-  (let [{cursor-x :x
+  (let [[player-x
+         player-y]    (rp/player-xy state)
+        {cursor-x :x
          cursor-y :y} (get-in state [:world :cursor])
-        target-x (+ cursor-x (case direction
-                               :left -1
-                               :right 1
-                               :up-left -1
-                               :up-right 1
-                               :down-left -1
-                               :down-right 1
-                               0))
-        target-y (+ cursor-y (case direction
-                               :up  -1
-                               :down 1
-                               :up-left -1
-                               :up-right -1
-                               :down-left 1
-                               :down-right 1
-                               0))
-        cursor-pos (rc/xy->pos (rc/bound 0 target-x (dec (get-in state [:world :viewport :width])))
-                               (rc/bound 0 target-y (dec (get-in state [:world :viewport :height]))))]
-    (assoc-in state [:world :cursor] cursor-pos)))
+        target-x      (+ cursor-x (case direction
+                                    :left -1
+                                    :right 1
+                                    :up-left -1
+                                    :up-right 1
+                                    :down-left -1
+                                    :down-right 1
+                                    0))
+        target-y      (+ cursor-y (case direction
+                                    :up  -1
+                                    :down 1
+                                    :up-left -1
+                                    :up-right -1
+                                    :down-left 1
+                                    :down-right 1
+                                    0))
+        cursor-pos    (rc/xy->pos (rc/bound 0 target-x (dec (get-in state [:world :viewport :width])))
+                                  (rc/bound 0 target-y (dec (get-in state [:world :viewport :height]))))]
+    (if (and (= (rw/current-state state) :select-throw-target)
+             (rc/farther-than? player-x player-y target-x target-y (* 5 (rp/player-dexterity state))))
+      (rc/ui-hint state "You can't throw that far.")
+      (assoc-in state [:world :cursor] cursor-pos))))

 (defn get-cursor-pos
   [state]


be/fe log routes

be/fe log routes

#20

--- src/cljc/swarmpit/routes.cljc
+++ src/cljc/swarmpit/routes.cljc
@@ -28,6 +28,7 @@
        "/services"      {:get  :services
                          :post :service-create}
        "/services/"     {:get    {[:id] {""          :service
+                                         "/logs"     :service-logs
                                          "/networks" :service-networks
                                          "/tasks"    :service-tasks}}
                          :delete {[:id] :service-delete}
@@ -62,11 +63,12 @@
 (def frontend ["" {"/"                        :index
                    "/login"                   :login
                    "/password"                :password
-                   "/services"                {""                :service-list
-                                               "/create/wizard"  {"/image"  :service-create-image
-                                                                  "/config" :service-create-config}
-                                               ["/" :id]         :service-info
-                                               ["/" :id "/edit"] :service-edit}
+                   "/services"                {""               :service-list
+                                               "/create/wizard" {"/image"  :service-create-image
+                                                                 "/config" :service-create-config}
+                                               ["/" :id]        {""      :service-info
+                                                                 "/edit" :service-edit
+                                                                 "/log"  :service-log}}
                    "/networks"                {""        :network-list
                                                "/create" :network-create
                                                ["/" :id] :network-info}


Throw exception on hash mismatch.

Throw exception on hash mismatch.

--- src/cljx/geschichte/sync.cljx
+++ src/cljx/geschichte/sync.cljx
@@ -187,9 +187,9 @@

                  (doseq [[trans-id val] (:values (<! fetched-ch))]
                    (when (and (uuid? trans-id) (not= trans-id (uuid val)))
-                     (let [msg (str "CRITICAL: Fetched ID:" trans-id
-                                    "does not match HASH" (uuid val)
-                                    "for value" val)]
+                     (let [msg (pr-str "CRITICAL: Fetched ID: "  trans-id
+                                       " does not match HASH "  (uuid val)
+                                       " for value " val)]
                        #+clj (throw (IllegalStateException. msg))
                        #+cljs (throw msg)))
                    (<! (-assoc-in store [trans-id] val))))


Docstring improvement.

Docstring improvement.

--- src/clojure/inet/data/dns.clj
+++ src/clojure/inet/data/dns.clj
@@ -172,10 +172,10 @@
     (domain-error "%s: invalid domain" (str orig))))

 (defn domain-next
-  "For the domain child which is a subdomain of domain parent, return the
-immediate child domain of parent which is either identical to child or also a
-parent domain of child.  Returns nil if there is no such domain.  Uses the
-implied empty root domain as the parent if not provided."
+  "For the domain `child` which is a subdomain of domain `parent`, return the
+immediate child domain of `parent` which is either identical to `child` or also
+a parent domain of `child`.  Returns `nil` if there is no such domain.  Uses
+the implied empty root domain as `parent` if not provided."
   ([child]
      (domain-next child nil))
   ([child parent]


Add more method overloading to defactivity

--- src/clojure/neko/activity.clj
+++ src/clojure/neko/activity.clj
@@ -113,7 +113,10 @@

   :on-start, :on-restart, :on-resume, :on-pause, :on-stop, :on-destroy
   - same as :on-create but require a one-argument function."
-  [name & {:keys [extends prefix on-create def] :as options}]
+  [name & {:keys [extends prefix on-create on-create-options-menu
+                  on-options-item-selected on-activity-result
+                  on-new-intent def]
+           :as options}]
   (let [options (or options {}) ;; Handle no-options case
         sname (simple-name name)
         prefix (or prefix (str sname "-"))
@@ -132,6 +135,10 @@
                           ~'onStop ~'superOnStop
                           ~'onCreateContextMenu ~'superOnCreateContextMenu
                           ~'onContextItemSelected ~'superOnContextItemSelected
+                          ~'onCreateOptionsMenu ~'superOnCreateOptionsMenu
+                          ~'onOptionsItemSelected ~'superOnOptionsItemSelected
+                          ~'onActivityResult ~'superOnActivityResult
+                          ~'onNewIntent ~'superOnNewIntent
                           ~'onDestroy ~'superOnDestroy})
        ~(when on-create
           `(defn ~(symbol (str prefix "onCreate"))
@@ -140,6 +147,33 @@
              (.superOnCreate ~'this ~'savedInstanceState)
              (def ~(vary-meta def assoc :tag name) ~'this)
              (~on-create ~'this ~'savedInstanceState)))
+       ~(when on-create-options-menu
+          `(defn ~(symbol (str prefix "onCreateOptionsMenu"))
+             [~(vary-meta 'this assoc :tag name),
+              ^android.view.Menu ~'menu]
+             (.superOnCreateOptionsMenu ~'this ~'menu)
+             (~on-create-options-menu ~'this ~'menu)
+             true))
+       ~(when on-options-item-selected
+          `(defn ~(symbol (str prefix "onOptionsItemSelected"))
+             [~(vary-meta 'this assoc :tag name),
+              ^android.view.MenuItem ~'item]
+             (~on-options-item-selected ~'this ~'item)
+             true))
+       ~(when on-activity-result
+          `(defn ~(symbol (str prefix "onActivityResult"))
+             [~(vary-meta 'this assoc :tag name),
+              ^int ~'requestCode,
+              ^int ~'resultCode,
+              ^android.content.Intent ~'intent]
+             (.superOnActivityResult ~'this ~'requestCode ~'resultCode ~'intent)
+             (~on-activity-result ~'this ~'requestCode ~'resultCode ~'intent)))
+       ~(when on-new-intent
+          `(defn ~(symbol (str prefix "onNewIntent"))
+             [~(vary-meta 'this assoc :tag name),
+              ^android.content.Intent ~'intent]
+             (.superOnNewIntent ~'this ~'intent)
+             (~on-new-intent ~'this ~'intent)))
        ~@(map #(let [func (options %)
                      event-name (keyword->camelcase %)]
                  (when func


aggregation query

aggregation query

--- src/ophion/server.clj
+++ src/ophion/server.clj
@@ -54,7 +54,7 @@
   (let [query (mapv identity (read-json (:body request)))
         label (get-in request [:params :label])
         result (aggregate/evaluate mongo label query)
-        out (map output result)]
+        out (map output (iterator-seq result))]
     {:status 200
      :headers {"content-type" "application/json"}
      :body (stream/->source out)}))


add util fn stringify-map-vals

add util fn stringify-map-vals

--- src/overtone/util.clj
+++ src/overtone/util.clj
@@ -264,6 +264,12 @@
       (re-find #"[Ll]inux" os)   :linux
       (re-find #"[Mm]ac" os)     :mac)))

+(defn stringify-map-vals
+  "converts a map by running all its vals through str
+  (or name if val is a keyword"
+  [m]
+  (into {} (map (fn [[k v]] [k (if (keyword? v) (name v) (str v))]) m)))
+
 (defn print-ascii-art-overtone-logo
   []
   (println (str "


added a bunch of option parsing stuff to core.cljs yolo

--- src/bitsplit_cli/core.cljs
+++ src/bitsplit_cli/core.cljs
@@ -42,6 +42,46 @@
 (def start? (partial = "start"))
 (def noop (constantly nil))

+(defn- seq->map [seq]
+  (->> seq
+       (partition 2)
+       (map vec)
+       (into { })))
+
+(defn transform-key [transforms key]
+  (->> transforms
+       (keys)
+       (filter #(contains? % key))
+       (first)
+       (transforms)))
+
+(defn transform-keys [transforms map]
+  (into { }
+        (for [[k v] map]
+          (let [new-key (transform-key transforms k)]
+            (if (nil? new-key)
+              [k nil]
+              [new-key v])))))
+
+(defn verify-options [options-map]
+  (doseq [[k v] options-map]
+    (when-not v
+      (throw (js/Error. (str "Unrecognized option: " k))))))
+
+(def key-transforms
+  {#{"-n" "--network"} "network"
+   #{"-i" "--interval"} "interval"
+   #{"-v" "--verbose"} "verbose"} )
+
+(def option-names #{"network" "interval" "verbose"})
+
+(def args->options
+  (comp
+   verify-options
+   (partial transform-keys key-transforms)
+   seq->map
+   rest))
+
 (defn -main [& [cmd & _ :as args]]
   (let [storage (->File splits-location)
         client (->Client (str base-directory "seed"))


CMR-2812 Fixing more tests

CMR-2812 Fixing more tests

--- system-int-test/test/cmr/system_int_test/ingest/collection_ingest_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_ingest_test.clj
@@ -393,16 +393,20 @@
   (let [coll1 (d/ingest "PROV1" (dc/collection))
         coll2 (d/ingest "PROV1" (dc/collection))
         token (e/login (s/context) "user1")]
+    ;; wait for the collections to be indexed so that ACLs will be valid
+    (index/wait-until-indexed)
     ;; Ingest some ACLs that reference the collection by concept id.
     (ac/create-acl token {:group_permissions [{:user_type "registered"
                                                :permissions ["read" "order"]}]
                           :catalog_item_identity {:name "coll1 ACL"
                                                   :provider_id "PROV1"
+                                                  :collection_applicable true
                                                   :collection_identifier {:entry_titles [(:entry-title coll1)]}}})
     (ac/create-acl token {:group_permissions [{:user_type "guest"
                                                :permissions ["read"]}]
                           :catalog_item_identity {:name "coll1/coll2 ACL"
                                                   :provider_id "PROV1"
+                                                  :collection_applicable true
                                                   :collection_identifier {:entry_titles [(:entry-title coll1) (:entry-title coll2)]}}})
     (index/wait-until-indexed)
     ;; Verify that the ACLs are found in Access Control Service search.


Add better constructor for scheduled executor

--- src/promesa/exec.cljc
+++ src/promesa/exec.cljc
@@ -364,7 +364,10 @@
      (let [parallelism (or parallelism (get-available-processors))
            factory     (or (some-> factory resolve-thread-factory)
                            (default-thread-factory :name "promesa/scheduled/%s"))]
-       (Executors/newScheduledThreadPool (int parallelism) factory))))
+
+
+       (doto (java.util.concurrent.ScheduledThreadPoolExecutor. (int parallelism) ^ThreadFactory factory)
+         (.setRemoveOnCancelPolicy true)))))

 #?(:clj
    (when vthreads-supported?


Add work-stealing-pool factory function.

--- src/promesa/exec.cljc
+++ src/promesa/exec.cljc
@@ -139,6 +139,12 @@
       (let [factory (resolve-thread-factory opts)]
         (Executors/newScheduledThreadPool (int n) factory)))))

+#?(:clj
+   (defn work-stealing-pool
+     "Creates a work-stealing thread pool."
+     ([] (Executors/newWorkStealingPool))
+     ([n] (Executors/newWorkStealingPool (int n)))))
+
 ;; --- Impl

 #?(:clj


fix Susanoo title to match NRDB

fix Susanoo title to match NRDB

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -847,7 +847,7 @@
    "Spiderweb"
    {:abilities [end-the-run]}

-   "Susanoo-No-Mikoto"
+   "Susanoo-no-Mikoto"
    {:abilities [{:req (req (not= (:server run) [:discard]))
                  :msg "make the Runner continue the run on Archives"
                  :effect (req (swap! state update-in [:run]


rework "look at top 5 of R&D" behavior to keep card order information

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -22,12 +22,11 @@

    "Architect"
    {:abilities [{:msg "look at the top 5 cards of R&D"
-                 :prompt (msg "You saw but could not install "
-                           (join ", " (map :title (filter #(= (:type %) "Operation") (take 5 (:deck corp)))))
-                           ". Choose a card to install")
+                 :prompt "Choose a card to install"
                  :activatemsg "uses Architect to look at the top 5 cards of R&D"
-                 :req (req (not (string? target))) :not-distinct true
-                 :choices (req (conj (filter #(not= (:type %) "Operation") (take 5 (:deck corp))) "No install"))
+                 :req (req (and (not (string? target))
+                                (not= (:type target) "Operation"))) :not-distinct true
+                 :choices (req (conj (take 5 (:deck corp)) "No install"))
                  :effect (effect (corp-install (move state side target :play-area) nil {:no-install-cost true}))}
                 {:msg "install a card from Archives" :choices (req (filter #(not= (:type %) "Operation") (:discard corp)))
                  :prompt "Choose a card to install" :not-distinct true


add catch blocks to coercion functions

add catch blocks to coercion functions

--- src/clj_money/coercion.clj
+++ src/clj_money/coercion.clj
@@ -20,14 +20,20 @@
   (map #(rule rule-key %) paths))

 (register-coerce-fn :integer    #(if (integer? %) % (Integer. %)))
-(register-coerce-fn :decimal    #(if (decimal? %) % (bigdec %)))
+(register-coerce-fn :decimal    #(if (decimal? %) % (try
+                                                      (bigdec %)
+                                                      (catch NumberFormatException e
+                                                        %))))
 (register-coerce-fn :keyword    #(if (keyword? %) % (keyword %)))
 (register-coerce-fn :local-date #(if (string? %) (parse-local-date %) %))
 (register-coerce-fn :integer-collection #(if (and (seq %) (every? (fn [v] (integer? v)) %))
                                            %
                                            (mapv (fn [value]
-                                                   (Integer. value))
-                                                %)))
+                                                   (try
+                                                     (Integer. value)
+                                                     (catch IllegalArgumentException e
+                                                       value)))
+                                                 %)))

 (defn coerce
   "Given a model and a list of coercion rules, applies the rules to the model"


Fix weird rectangle bug

Fix weird rectangle bug

--- src/cljs/pizarra/core.cljs
+++ src/cljs/pizarra/core.cljs
@@ -116,7 +116,7 @@

 (defn next-point [points x y f]
   (if (zero? (count points))
-    [[x y]]
+    [[x y] [x y]]
     (let [points (assoc points 1 [x y])]
       (f points))))