Minor

Minor

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -69,7 +69,7 @@
   (reify om/IRender
     (render [_]
       (dom/div nil
-               (bs/center (dom/h5 nil "Neues Argument mit dieser Referenz erzeugen"))
+               (bs/center (dom/h5 nil "Finde Aussage in der Diskussion"))
                (om/build rlib/current-reference-component {})
                (om/build find/form-view {})
                (om/build find/results-view data)))))
@@ -98,7 +98,7 @@
                            "Wo wird diese Referenz verwendet?")
         " "
         (bs/button-primary #(lib/change-view! :reference-create-with-ref)
-                           "Neues Argument mit Referenz erstellen")))))
+                           "Springe in die Diskussion")))))

 (defn usage-view
   "List single usages of reference."


Updated project.clj for ring-jetty-adapter to 0.3.0-beta1

--- ring-jetty-adapter/project.clj
+++ ring-jetty-adapter/project.clj
@@ -1,8 +1,8 @@
-(defproject ring/ring-jetty-adapter "0.2.5"
+(defproject ring/ring-jetty-adapter "0.3.0-beta1"
   :description "Ring Jetty adapter."
   :url "http://github.com/mmcgrana/ring"
-  :dependencies [[ring/ring-core "0.2.5"]
-                 [ring/ring-servlet "0.2.5"]
+  :dependencies [[ring/ring-core "0.3.0-beta1"]
+                 [ring/ring-servlet "0.3.0-beta1"]
                  [org.mortbay.jetty/jetty "6.1.14"]
                  [org.mortbay.jetty/jetty-util "6.1.14"]]
   :dev-dependencies [[lein-clojars "0.6.0"]])


initial implementation of CLJS pprint

initial implementation of CLJS pprint

--- pp-node-server/src/format/cljs-pp.cljs
+++ pp-node-server/src/format/cljs-pp.cljs
@@ -1,6 +1,44 @@
 (ns format.clj-pp
-  (:require [cljs.nodejs :as node]
-            [utils :as util]))
+  (:require [cljs.pprint :refer [write
+                                 *print-pretty*
+                                 *print-pprint-dispatch*
+                                 *print-right-margin*
+                                 *print-miser-width*
+                                 *print-base*
+                                 *print-radix*
+                                 *print-suppress-namespaces*
+                                 code-dispatch
+                                 simple-dispatch]]
+            [cljs.reader :as reader]))

-(defn format-clj [input _]
-  input)
+(def dispatch-mode {"clj" code-dispatch
+                    "edn" simple-dispatch})
+
+(def default-settings {:right-margin        *print-right-margin*
+                       :miser-width         *print-miser-width*
+                       :base                *print-base*
+                       :level               *print-level*
+                       :radix               *print-radix*
+                       :suppress-namespaces *print-suppress-namespaces*
+                       :pretty              *print-pretty*
+                       :dispatch            *print-pprint-dispatch*})
+
+(defn format-string
+  [input mode settings]
+  (let [presets (merge default-settings settings)
+        result  (write (reader/read-string input)
+                       :pretty              (:pretty presets)
+                       :stream              nil
+                       :right-margin        (:right-margin presets)
+                       :miser-width         (:miser-width presets)
+                       :base                (:base presets)
+                       :length              (:length presets)
+                       :radix               (:radix presets)
+                       :suppress-namespace  (:suppress-namespace presets)
+                       :dispatch            (get dispatch-mode format-type))]
+    (print result)
+    result))
+
+(defn format-clj [tipe input settings]
+  ([input mode] (format-clj input mode nil))
+  ([input mode settings] (format-string input mode settings)))


(Empty) API call handlers

(Empty) API call handlers

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -43,6 +43,59 @@
                     :configuration (:configuration request)}]
         (send-response response)))

+(defn system-banners
+    [request]
+    )
+
+(defn create-job
+    [request]
+    )
+
+(defn delete-job
+    [request]
+    )
+
+(defn start-job
+    [request]
+    )
+
+(defn enable-job
+    [request]
+    )
+
+(defn disable-job
+    [request]
+    )
+
+(defn get-job
+    [request]
+    )
+
+(defn update-job
+    [request]
+    )
+
+(defn get-jobs
+    [request]
+    )
+
+(defn get-job-results
+    [request]
+    )
+
+(defn job-started-handler
+    [request]
+    )
+
+(defn job-finished-handler
+    [request]
+    )
+
+(defn job-results
+    [request]
+    )
+
+
 (defn unknown-call-handler
     [uri method]
     (let [response {:status :error


let 3 table updates happen concurrently

let 3 table updates happen concurrently

--- src/er_cassandra/dump/tables.clj
+++ src/er_cassandra/dump/tables.clj
@@ -401,7 +401,7 @@
                              {:notify-s (log-notify-stream)}
                              r-s))))
                        (stream/realize-each)
-                       (stream/buffer 1)
+                       (stream/buffer 3)
                        (stream/reduce (fn [c _] (inc c)) 0))]
     (info "load-tables loaded " table-cnt "tables - FINISHED")
     (return table-cnt)))


Better container FAQ for enterprise.

Better container FAQ for enterprise.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -10,6 +10,7 @@
             [frontend.components.common :as common]
             [frontend.components.forms :as forms]
             [frontend.components.inputs :as inputs]
+            [frontend.config :as config]
             [frontend.routes :as routes]
             [frontend.state :as state]
             [frontend.stefon :as stefon]
@@ -123,11 +124,20 @@
    [:div.mini-faq-item
     [:h3 "What are containers?"]
     [:p
-     "Containers are what we call the virtual machines that your tests run in. Your current plan has "
-     (get-in project-data [:plan :containers])
-     " containers and supports up to "
-     (plan-model/max-parallelism (:plan project-data))
-     "x paralellism."]
+     "Containers are what we call the virtual machines that your tests run in. "
+     (if (config/enterprise?)
+       (list
+        "You currently have "
+        (get-in project-data [:plan :containers])
+        " containers and can use up to "
+        (plan-model/max-parallelism (:plan project-data))
+        "x parallelism.")
+       (list
+        "Your current plan has "
+        (get-in project-data [:plan :containers])
+        " containers and supports up to "
+        (plan-model/max-parallelism (:plan project-data))
+        "x parallelism."))]

     [:p "With 16 containers you could run:"]
     [:ul


Env var settings in card, form in modal dialog

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -7,6 +7,7 @@
             [frontend.components.common :as common]
             [frontend.components.forms :as forms]
             [frontend.components.inputs :as inputs]
+            [frontend.components.pieces.button :as button]
             [frontend.components.pieces.icon :as icon]
             [frontend.components.pieces.modal :as modal]
             [frontend.components.pieces.table :as table]
@@ -28,7 +29,7 @@
             [goog.crypt.base64 :as base64]
             [goog.string :as gstring]
             [om.core :as om :include-macros true]
-            [frontend.components.pieces.button :as button])
+            [frontend.components.pieces.card :as card])
   (:require-macros [frontend.utils :refer [html]]))

 (defn branch-names [project-data]
@@ -437,63 +438,79 @@

 (defn env-vars [project-data owner]
   (reify
-    om/IRender
-    (render [_]
+    om/IInitState
+    (init-state [_]
+      {:show-modal? false})
+    om/IRenderState
+    (render-state [_ {:keys [show-modal?]}]
       (let [project (:project project-data)
             inputs (inputs/get-inputs-from-app-state owner)
             new-env-var-name (:new-env-var-name inputs)
             new-env-var-value (:new-env-var-value inputs)
             project-id (project-model/id project)]
         (html
+         ;; The :section and :article here are artifacts of the legacy styling
+         ;; of the settings pages, and should go away as the structure of the
+         ;; settings pages is addressed.
          [:section
           [:article
-           [:h2 "Environment Variables for " (vcs-url/project-name (:vcs_url project))]
-           [:div
-            [:p
-             "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
-             "The values can be any bash expression and can reference other variables, such as setting "
-             [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
-
-            [:p
-             " To disable string substitution you need to escape the " [:code "$"]
-             " characters by prefixing them with " [:code "\\"] "."
-             " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
-            [:form
-             [:div.form-group
-              [:label "Name"]
-              [:input.form-control#env-var-name
-               {:required true, :type "text", :value new-env-var-name
-                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
-             [:div.form-group
-              [:label "Value"]
-              [:input.form-control#env-var-value
-               {:required true
-                :type "text"
-                :value new-env-var-value
-                :auto-complete "off"
-                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]
-
-             [:div.form-group
-              (forms/managed-button
-               [:input.btn.btn-primary {:data-failed-text "Failed",
-                                        :data-success-text "Added",
-                                        :data-loading-text "Adding...",
-                                        :value "Add Variable",
-                                        :type "submit"
-                                        :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]]
-            (when-let [env-vars (seq (:envvars project-data))]
-              (om/build table/table
-                        {:rows env-vars
-                         :columns [{:header "Name"
-                                    :cell-fn :name}
-                                   {:header "Value"
-                                    :cell-fn :value}
-                                   {:header "Remove"
-                                    :type #{:shrink :right}
-                                    :cell-fn
-                                    (fn [env-var]
-                                      (om/build remove-env-var-button {:env-var env-var
-                                                                       :project-id project-id}))}]}))]]])))))
+           (card/titled
+            {:action (button/button {:on-click #(om/set-state! owner :show-modal? true)
+                                     :primary? true
+                                     :size :medium}
+                             "Add Variable")}
+            (str "Environment Variables for " (vcs-url/project-name (:vcs_url project)))
+            (html
+             [:div
+              [:p
+               "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
+               "The values can be any bash expression and can reference other variables, such as setting "
+               [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
+
+              [:p
+               " To disable string substitution you need to escape the " [:code "$"]
+               " characters by prefixing them with " [:code "\\"] "."
+               " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "."]
+              (when show-modal?
+                (let [close-fn #(om/set-state! owner :show-modal? false)]
+                  (modal/modal-dialog {:title "Add an Environment Variable"
+                                       :body (html
+                                              [:form
+                                               [:div.form-group
+                                                [:label "Name"]
+                                                [:input.form-control#env-var-name
+                                                 {:required true ,:type "text" ,:value new-env-var-name
+                                                  :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
+                                               [:div.form-group
+                                                [:label "Value"]
+                                                [:input.form-control#env-var-value
+                                                 {:required true
+                                                  :type "text"
+                                                  :value new-env-var-value
+                                                  :auto-complete "off"
+                                                  :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]])
+                                       :actions [(button/button {:on-click close-fn} "Cancel")
+                                                 (forms/managed-button
+                                                  [:input.btn.btn-primary {:data-failed-text "Failed" ,
+                                                                           :data-success-text "Added" ,
+                                                                           :data-loading-text "Adding..." ,
+                                                                           :value "Add Variable" ,
+                                                                           :type "submit"
+                                                                           :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]
+                                       :close-fn close-fn})))
+              (when-let [env-vars (seq (:envvars project-data))]
+                (om/build table/table
+                          {:rows env-vars
+                           :columns [{:header "Name"
+                                      :cell-fn :name}
+                                     {:header "Value"
+                                      :cell-fn :value}
+                                     {:header "Remove"
+                                      :type #{:shrink :right}
+                                      :cell-fn
+                                      (fn [env-var]
+                                        (om/build remove-env-var-button {:env-var env-var
+                                                                         :project-id project-id}))}]}))]))]])))))

 (defn advance [project-data owner]
   (reify


Changes to prepare bet-you-miss for public presentation

--- spectacles/src/spectacles/bet_you_miss.clj
+++ spectacles/src/spectacles/bet_you_miss.clj
@@ -15,20 +15,15 @@
 (defn update-state [state]
   ; Update sketch state by changing circle color and position.
   {:color (mod (+ (:color state) 0.7) 255)
-   :angle (+ (:angle state) 0.2)})
+   :angle (+ (:angle state) 0.1)})

-(defn draw-state [state]
-  ; Clear the sketch by filling it with light-grey color.
-  (q/background 240)
-  ; Set circle color.
-  (q/fill (:color state) 255 255)
-  ; Calculate x and y coordinates of the circle.
+(defn draw-all [state translation-x translation-y]
+    ; Calculate x and y coordinates of the circle.
   (let [angle (:angle state)
         x (* 125 (q/sin angle))
         y (* 125 (q/cos angle))]
     ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
+    (q/with-translation [translation-x translation-y]
       ; Draw the circle.
       (q/ellipse x y 100 100)
       (q/fill 255 (:color state) 255)
@@ -44,8 +39,7 @@
         x (* 1 (q/sin angle))
         y (* 1 (q/cos angle))]
     ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
+    (q/with-translation [translation-x translation-y]
       ; Draw the circle.
       (q/ellipse x y 100 100)
       (q/fill 255 (:color state) 255)
@@ -60,8 +54,7 @@
         x (* 175 (q/cos angle))
         y (* 175 (q/sin angle))]
     ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
+    (q/with-translation [translation-x translation-y]
       ; Draw the circle.
       (q/ellipse x y 100 100)
       (q/fill 255 (:color state) 255)
@@ -76,8 +69,7 @@
         x (* 175 (q/cos angle))
         y (* 175 (q/cos angle))]
     ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
+    (q/with-translation [translation-x translation-y]
       ; Draw the circle.
       (q/ellipse x y 100 100)
       (q/fill 255 (:color state) 255)
@@ -92,8 +84,7 @@
         x (* -175 (q/sin angle))
         y (* 175 (q/sin angle))]
     ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
+    (q/with-translation [translation-x translation-y]
       ; Draw the circle.
       (q/ellipse x y 100 100)
       (q/fill 255 (:color state) 255)
@@ -102,12 +93,22 @@
       (q/ellipse x y 50 50)
       (q/fill (:color state) 255 255)
       (q/ellipse x y 25 25)
-      (q/ellipse x y 1 1)))
-  )
+      (q/ellipse x y 1 1))))

-;; LifeInLights sketch
-;; Artist: Galen Arnett
-;; Date Created: 2016-01-19
+(defn draw-state [state]
+
+  ; Clear the sketch by filling it with light-grey color.
+  (q/background 0)
+  ; Set circle color.
+  (q/fill (:color state) 255 255)
+
+  (draw-all state (/ (q/width) 4) (* 2 (/ (q/height) 3)))
+
+  (draw-all state (* 3 (/ (q/width) 4)) (* 2 (/ (q/height) 3))))
+
+;; ;; LifeInLights sketch
+;; ;; Artist: Galen Arnett
+;; ;; Date Created: 2016-01-19

 ;; (q/defsketch bet-you-miss
 ;;   :title "Bet You Miss - Galen Arnett"


add weighting function

add weighting function

--- src/markov/core.clj
+++ src/markov/core.clj
@@ -17,8 +17,11 @@
   "Split a sentence into a seq of words"
    (re-seq #"\w+" sentence))

-(defn hash-ngram [ngram]
-  {:root (take 2 ngram) :next-word (last ngram)})
+(defn hash-ngram [n ngram]
+  {:n n :root (take (dec n) ngram) :next-word (last ngram)})
+
+(defn hash-trigram [ngram]
+  (hash-ngram 3 ngram))

 (defn gen-ngram
   "split a sentence into groups of 'n' "
@@ -52,21 +55,49 @@
         trigrams (mapcat gen-trigram document)
         ]

-       (map hash-ngram trigrams)
+       (map hash-trigram trigrams)
+    )
+  )
+
+(defn weight-transitions [next-choices]
+  (let [
+        unique-transitions (distinct next-choices)
+        ]
+      (loop [u unique-transitions, w ()]
+        (let [
+              current-trans (first u)
+              transition-ct (count (filter #(= (:next-word current-trans) (:next-word  %)) next-choices))
+              weighted-transition {:root (:root current-trans) :next-word (:next-word current-trans) :weight transition-ct :n (:n current-trans)}
+;              dummy (println "WT : " w)
+              ]
+          (if (empty? u)
+            w
+            (recur (rest u) (conj w weighted-transition))
+            )
+          )
+        )
     )
   )

 (defn generate-sentence [hashed-trigrams]
   "Use a set of tri-grams to generate a  "
-  (let [starters (filter #(= "START" (first (:root %))) hashed-trigrams)
+  (let [;Filter sentence starting ngrams
+        starters (filter #(= "START" (first (:root %))) hashed-trigrams)
         starter-idx (rand-int (count starters))
+        ;Fileter sentence continuations
         sentence-pieces (filter #(not= "START" (first (:root %))) hashed-trigrams)
+        ;choose a random starter
         starter (nth starters starter-idx)
+        ;take the word after the START tag
         root (second (:root starter))
+        ;take the  word following the root to begin the sentence
         sentence (seq [root (:next-word starter)])
         ]
     (loop [s sentence, prev-two sentence]
       (let [next-choices (filter #(= prev-two (:root %)) sentence-pieces)
+;            dummy (println "NC : " next-choices)
+            weighted-choices (weight-transitions next-choices)
+            dummy (println "Weighted Choices : " weighted-choices)
             next-word (:next-word (nth next-choices (rand-int (count next-choices))))
             next-prev (seq [(last s) next-word])
             ]
@@ -84,6 +115,6 @@
   "I don't do a whole lot ... yet."
   [& args]
   (def shakespeare  (generate-corpus-trigrams "shakespeare_complete"))
-  (generate-sentence shakespeare)
+  (println (generate-sentence shakespeare))
      )


Register:  Show totals per unit

Register:  Show totals per unit

--- src/accounting/core.cljs
+++ src/accounting/core.cljs
@@ -151,10 +151,13 @@
                    (:parts tx))))
        (apply concat)
        (filter #(= account (:account %)))
-       (map (fn [{:keys [account amount unit] :as part}]
-              (merge part
-                     {:account (account-key->str account)
-                      :amount (display-amount amount unit)})))))
+       (reduce (fn [parts {:keys [amount unit] :as part}]
+                 (let [totals ((or (peek parts) {}) :totals {})]
+                   (conj parts
+                         (assoc part :totals
+                                (assoc totals unit
+                                       (+ amount (totals unit 0)))))))
+               [])))

 (def right-align #js {:style #js {:textAlign "right"}})

@@ -221,14 +224,17 @@
     "Account: "
     (dom/input #js {:value register-account, :onKeyDown (send! :register)})
     (dom/table nil
-      (render-table-headings ["Date" "Description" "Amount" "Note"])
+      (render-table-headings ["Date" "Description" "Amount" "Note" "Totals"])
       (apply dom/tbody nil
-        (for [{:keys [date description amount note]} register-parts]
-          (dom/tr nil
+        (for [{:keys [date description amount note unit totals]} register-parts]
+          (apply dom/tr nil
             (dom/td nil date)
             (dom/td nil description)
-            (dom/td right-align amount)
-            (dom/td nil note)))))))
+            (dom/td right-align (display-amount amount unit))
+            (dom/td nil note)
+            (interpose (dom/td nil " + ")
+              (for [[total-unit total-amount] totals]
+                (dom/td right-align (display-amount total-amount total-unit))))))))))

 (defn render-export [state]
   (dom/p nil "Export screen coming soon!"))


Simplify using an intermediate symbol

Simplify using an intermediate symbol

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -395,11 +395,13 @@

               arglist (-> fn-meta :arglists first)

+              route-params (->> endpoint-context
+                                (filter keyword?)
+                                (map (comp symbol name))
+                                set)
+
               arglist-resolver (create-arglist-resolver endpoint-arg-resolvers
-                                                        (->> endpoint-context
-                                                             (filter keyword?)
-                                                             (map (comp symbol name))
-                                                             set)
+                                                        route-params
                                                         arglist)

               context-length (count container-context)


Clarify doc string.

Clarify doc string.

--- src/afterglow/rhythm.clj
+++ src/afterglow/rhythm.clj
@@ -178,7 +178,8 @@
 (defn marker-phase
   "Helper function to calculate the beat, bar, or phrase phase at a
   given `instant` (in millseconds), given a `start` time (also in
-  milliseconds) and `interval` (in milliseconds)."
+  milliseconds) and `interval` (in milliseconds) between beats, bars,
+  or phrases."
   [instant start interval]
   (let [marker-ratio (/ (- instant start) interval)]
     (- (double marker-ratio) (long marker-ratio))))


Macro to facilitate use

Macro to facilitate use

--- src/assert_json/core.clj
+++ src/assert_json/core.clj
@@ -5,25 +5,30 @@
   (get m key ::nothing-here))

 (defn- property-not-found [property]
-  (Exception. (str "Property not found: " (name property))))
+  (Exception. (str "Property not found: " property)))

 (defn- wrong-property-type
   [property m-val value]
   (Exception. (str "Wrong type value for property "
-                   (name property) ": expected " (type value)
+                   property ": expected " (type value)
                    ", found: " (type m-val))))

 (defn- wrong-property-value
   [property m-val value]
-  (Exception. (str "Wrong value for property " (name property)
+  (Exception. (str "Wrong value for property " property
                    ": expected " value
                    ", found: " m-val)))

-(defn assert-property [m property value]
+(defn- assert-property [m property value]
   (let [m-val (has-key m property)]
     (cond (= ::nothing-here m-val) (throw (property-not-found property))
           (not= (type m-val) (type value)) (throw (wrong-property-type property m-val value))
           (not= value m-val) (throw (wrong-property-value property m-val value))
           :default true)))

+(defmacro assert-json [json & body]
+  `(let [m# (parse-string ~json)]
+     (map (fn [c#] (assert-property m# (first c#) (second c#)))
+          (partition 2 (vector ~@body)))))

+


mosaic might be working!

mosaic might be working!

--- src/mosaic/tile.clj
+++ src/mosaic/tile.clj
@@ -29,7 +29,7 @@
 (defn gen-tiles [n ^BufferedImage b]
   "Generate tiles of size n from image b.
    Returns a list of BufferedImages."
-  (map tile (grid 100 (.getWidth b) (.getHeight b)) (repeat b)))
+  (map tile (grid n (.getWidth b) (.getHeight b)) (repeat b)))

 (defn save-image [^BufferedImage b ^String f]
   "Save a BufferedImage to filename f."
@@ -100,12 +100,12 @@
   "Insert image a into image b at coordinates dx,dy."
   (let [da (.getRaster a)
 	db (.getRaster b)]
-    (for [x (range 0 (.getWidth da))
-	  y (range 0 (.getHeight da))
-	  z (range 0 (.getNumBands da))]
-      (.setSample db (+ dx x) (+ dy y) z
-		  (.getSample da x y z))))
-  nil)
+    (reduce = nil
+	      (for [x (range 0 (.getWidth da))
+		    y (range 0 (.getHeight da))
+		    z (range 0 (.getNumBands da))]
+		(.setSample db (+ dx x) (+ dy y) z
+			    (.getSample da x y z))))))

 (defn mosaic [^BufferedImage source
 	      ^BufferedImage target
@@ -114,10 +114,10 @@
 	      s] ; sample size
   (let [canvas (gen-canvas n w target)
 	tiles (sample-tiles s (gen-tiles n source))]
-    (map #(insert!
-	   (:tile (best-match n tiles (tile % canvas)))
-	   canvas (first %) (second %))
-	 (grid n (.getWidth canvas) (.getHeight canvas)))
+    (dorun (map #(insert!
+		  (:tile (best-match n tiles (tile % canvas)))
+		  canvas (first %) (second %))
+		(grid n (.getWidth canvas) (.getHeight canvas))))
     canvas))


Update system tests

Update system tests

--- test/com/wsscode/pathom/system_test.clj
+++ test/com/wsscode/pathom/system_test.clj
@@ -31,6 +31,9 @@

 (test/defspec generator-makes-valid-queries {:max-size 12 :num-tests 50} (valid-queries-props))

+(comment
+  (tc/quick-check 50 (valid-queries-props) :max-size 12))
+
 (defn normalize-mutation-error [x]
   (walk/prewalk
     (fn [x]
@@ -106,43 +109,7 @@
 (test/defspec parser-system {:max-size 12 :num-tests 100} (parser-test-props pct/parser-env))

 (comment
-  (let [props (gen/generate (gen/vector-distinct gen/keyword-ns {:min-elements 8
-                                                                 :max-elements 100})
-                4)
-        query-gen (s.query/make-gen {::s.query/gen-property
-                                     (fn [_] (gen/elements props))
-
-                                     ::s.query/gen-params
-                                     (fn [_] (gen/map gen/keyword gen/simple-type-printable {:max-elements 3}))}
-                    ::s.query/gen-query)
-        queries (take 20 (gen/sample-seq query-gen 16))]
-    (def queries queries))
-
-  (let [env pct/parser-env
-        plugins      [pp/profile-plugin]
-        parser       (p/parser {::p/plugins plugins
-                                :mutate     pt/mutate-fn})
-
-        async-parser (p/async-parser {::p/plugins plugins
-                                      :mutate     pt/mutate-fn})
-        {:keys [async-reader] :as env} env]
-
-    (doseq [query queries]
-      (parser env query))
-
-    #_
-    (criterium/with-progress-reporting
-      (criterium/bench
-        (doseq [query queries]
-          #_ (parser env query)
-          ((comp <!! async-parser) (assoc env ::p/reader async-reader) query)))))
-
-  (time
-    (clojure.test/test-vars [#'profile-speed]))
-
-  (criterium/with-progress-reporting
-    (criterium/bench
-      (clojure.test/test-vars [#'profile-speed]))))
+  (tc/quick-check 100 (parser-test-props pct/parser-env) :max-size 12))

 (defn connect-read-props [env]
   (let [props (gen/generate (gen/vector-distinct gen/keyword-ns {:min-elements 8
@@ -167,7 +134,12 @@
            (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers]
                                          ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))

-(defn connect-smart-read-props [env]
+(test/defspec connect-read {:max-size 10 :num-tests 100} (connect-read-props pct/parser-env))
+
+(comment
+  (tc/quick-check 100 (connect-read-props pct/parser-env) :max-size 10))
+
+(defn connect-read-planned-props [env]
   (let [props (gen/generate (gen/vector-distinct gen/keyword-ns {:min-elements 8
                                                                  :max-elements 50})
                 4)]
@@ -178,21 +150,70 @@
                                            ::s.query/gen-query)
                                          (gen/fmap p/remove-query-wildcard))]
                       {:index index :query query})]
-      (let [plugins      [p/error-handler-plugin]
-            parser       (p/parser {::p/plugins plugins})
-
+      (let [plugins         [p/error-handler-plugin]
+            parser          (p/parser {::p/plugins plugins})
+            async-parser    (p/async-parser {::p/plugins plugins})
             parallel-parser (p/parallel-parser {::p/plugins plugins})

-            env          (assoc env ::p/reader [p/map-reader pc/all-readers2]
-                                    ::pc/indexes index
-                                    ::pc/resolver-dispatch pct/resolve-fn)]
-        (= (parser env query)
+            env             (assoc env ::p/reader [p/map-reader pc/all-readers]
+                                       ::pc/indexes index
+                                       ::pc/resolver-dispatch pct/resolve-fn)]
+        (= (parser (assoc env ::p/reader [p/map-reader pc/all-readers2]) query)
+
+           (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers2]
+                                         ::pc/resolver-dispatch pct/async-resolve-fn) query))
+
            (<!! (parallel-parser (assoc env ::p/reader [p/map-reader pc/all-parallel-readers]
-                                         ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))
-
-(test/defspec connect-read {:max-size 10 :num-tests 100} (connect-read-props pct/parser-env))
-
-(comment
+                                            ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))
+
+#_(test/defspec connect-read-planned {:max-size 10 :num-tests 100} (connect-read-planned-props pct/parser-env))
+
+(comment
+  (tc/quick-check 100 (connect-read-planned-props pct/parser-env) :max-size 10))
+
+(comment
+  (let [props     (gen/generate (gen/vector-distinct gen/keyword-ns {:min-elements 8
+                                                                     :max-elements 100})
+                    4)
+        query-gen (s.query/make-gen {::s.query/gen-property
+                                     (fn [_] (gen/elements props))
+
+                                     ::s.query/gen-params
+                                     (fn [_] (gen/map gen/keyword gen/simple-type-printable {:max-elements 3}))}
+                    ::s.query/gen-query)
+        queries   (take 20 (gen/sample-seq query-gen 16))]
+    (def queries queries))
+
+  (let [env          pct/parser-env
+        plugins      [pp/profile-plugin]
+        parser       (p/parser {::p/plugins plugins
+                                :mutate     pt/mutate-fn})
+
+        async-parser (p/async-parser {::p/plugins plugins
+                                      :mutate     pt/mutate-fn})
+        {:keys [async-reader] :as env} env]
+
+    (doseq [query queries]
+      (parser env query))
+
+    #_(criterium/with-progress-reporting
+        (criterium/bench
+          (doseq [query queries]
+            #_(parser env query)
+            ((comp <!! async-parser) (assoc env ::p/reader async-reader) query)))))
+
+  (time
+    (clojure.test/test-vars [#'profile-speed]))
+
+  (criterium/with-progress-reporting
+    (criterium/bench
+      (clojure.test/test-vars [#'profile-speed]))))
+
+(comment
+  (tc/quick-check 100 (connect-read-props-planned pct/parser-env) :max-size 10))
+
+(comment
+
   (gen/sample
     (s.query/make-gen (pcg/gen-connect-query {::pc/indexes indexes})
       ::s.query/gen-query))
@@ -261,32 +282,56 @@
   (pt/key-ex-value :hP0*/dN04E {})

   (time
-    (tc/quick-check 300 (connect-read-props pct/parser-env) :max-size 10))
-
-  (time
     (tc/quick-check 300 (connect-smart-read-props pct/parser-env) :max-size 10))

-  (let [{:keys [index query]} '{:index #:com.wsscode.pathom.connect{:index-resolvers #:A{A #:com.wsscode.pathom.connect{:sym A/A,
-                                                                                :input #{:.a/-f6},
-                                                                                :output [:.a/-f6
-                                                                                #:CE?{:W27 [:.a/-f6]}]}},
-                                                                    :index-io {#{:.a/-f6} {:.a/-f6 {},
-                                                                                :CE?/W27 #:.a{:-f6 {}}}},
-                                                                    :index-oir #:CE?{:W27 {#{:.a/-f6} #{A/A}}},
-                                                                    :idents #{:.a/-f6}},
-                                :query [{[:.a/-f6 0] [:CE?/W27]}]}
+  (let [{:keys [index query]} '{:index
+                                       {:com.wsscode.pathom.connect/index-resolvers
+                                                                           {A/*
+                                                                            {:com.wsscode.pathom.connect/sym A/*,
+                                                                             :com.wsscode.pathom.connect/input #{:y3/M},
+                                                                             :com.wsscode.pathom.connect/output [:!lC/Or]},
+                                                                            A0/*
+                                                                            {:com.wsscode.pathom.connect/sym A0/*,
+                                                                             :com.wsscode.pathom.connect/input #{:N/e.},
+                                                                             :com.wsscode.pathom.connect/output [{:!lC/Or [:-YD/*?]}]},
+                                                                            A/A
+                                                                            {:com.wsscode.pathom.connect/sym A/A,
+                                                                             :com.wsscode.pathom.connect/input #{:-YD/*?},
+                                                                             :com.wsscode.pathom.connect/output [:y3/M :N/e.]}},
+                                        :com.wsscode.pathom.connect/index-io
+                                                                           {#{:y3/M} {:!lC/Or {}},
+                                                                            #{:N/e.} {:!lC/Or {:-YD/*? {}}},
+                                                                            #{:-YD/*?} {:y3/M {}, :N/e. {}}},
+                                        :com.wsscode.pathom.connect/index-oir
+                                                                           {:!lC/Or {#{:y3/M} #{A/*}, #{:N/e.} #{A0/*}},
+                                                                            :y3/M {#{:-YD/*?} #{A/A}},
+                                                                            :N/e. {#{:-YD/*?} #{A/A}}},
+                                        :com.wsscode.pathom.connect/idents #{:N/e. :-YD/*? :y3/M}},
+                                :query [{[:N/e. 0] [{:!lC/Or [{[:-YD/*? 0] [{:!lC/Or [*]}]}]}]}]}
         env pct/parser-env
         plugins      [p/error-handler-plugin]
         parser       (p/parser {::p/plugins plugins})
-
+        async-parser (p/async-parser {::p/plugins plugins})
         parallel-parser (p/parallel-parser {::p/plugins plugins})

-        env          (assoc env ::p/reader [p/map-reader pc/all-readers2]
+        env          (assoc env ::p/reader [p/map-reader pc/all-readers]
                                 ::pc/indexes index
-                                ::pc/resolver-dispatch resolve-fn)]
-    [(parser env query)
-     (<!! (parallel-parser (assoc env ::p/reader [p/map-reader pc/all-parallel-readers]
-                                      ::pc/resolver-dispatch pct/async-resolve-fn) query))])
+                                ::pc/resolver-dispatch pct/resolve-fn)
+
+        res [(parser env query)
+             (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers]
+                                           ::pc/resolver-dispatch pct/async-resolve-fn) query))
+
+             (parser (assoc env ::p/reader [p/map-reader pc/all-readers2]) query)
+
+             (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers2]
+                                           ::pc/resolver-dispatch pct/async-resolve-fn) query))
+
+             (<!! (parallel-parser (assoc env ::p/reader [p/map-reader pc/all-parallel-readers]
+                                              ::pc/resolver-dispatch pct/async-resolve-fn) query))]]
+    [(apply = res) (map vector
+                     res
+                     ["reader" "async-reader" "reader2" "async-reader2" "parallel-reader"])])

   (pt/key-ex-value :CE?/W27 pct/parser-env)
   (let [props   (gen/generate (gen/vector-distinct gen/keyword-ns {:min-elements 8


fixed reading the port number in string format into a number #6

--- src/bitfondue/config.clj
+++ src/bitfondue/config.clj
@@ -29,4 +29,4 @@
    :port 587})

 (def ssl
-  {:ssl-port (env-default :ssl-port 443)})
+  {:ssl-port (read-string (env-default :ssl-port 443))})


Delete unused variables

Delete unused variables

--- test/freecoin/test/handlers/sign_in.clj
+++ test/freecoin/test/handlers/sign_in.clj
@@ -35,11 +35,6 @@
             [freecoin.test-helpers.store :as test-store]
             [freecoin.email-activation :as email-activation]
             [taoensso.timbre :as log]))
-
-(def client-id "CLIENT_ID")
-(def client-secret "CLIENT_SECRET")
-(def callback-uri "CALLBACK_URI")
-(def public-key "PUBLICK_KEY") ;; TODO: load this from jwk file

 (def absolute-path (partial routes/absolute-path))


fix edge util current word bug

fix edge util current word bug

--- src/lt/plugins/ltfiles/util.cljs
+++ src/lt/plugins/ltfiles/util.cljs
@@ -7,7 +7,7 @@
   [string cursor]
   (str
    (re-find #"\S+$" (subs string 0 cursor))
-   (re-find #"\S+" (subs string cursor))))
+   (re-find #"^\S+" (subs string cursor))))

 (defn current-word
   "Current word under cursor"
@@ -30,3 +30,8 @@
          (fn [err stdout stderr]
            (when (seq stdout) (println "STDOUT: " stdout))
            (when (seq stderr) (println "STDERR: " stderr)))))
+
+(comment
+ (assert (= "this" (current-word* "this is a test" 3)))
+ (assert (= "this" (current-word* "this is a test" 4)))
+  )


Doesn't matter which job greedily receives peers

--- test/onyx/log/greedy_multi_job_test.clj
+++ test/onyx/log/greedy_multi_job_test.clj
@@ -129,8 +129,8 @@
   (playback-log (:log env) (extensions/subscribe-to-log (:log env) ch) ch 2000))

 (fact "5 peers were allocated to job 1, task A, 5 peers were allocated to job 1, task B"
-      (get-counts replica-1 [j1 j2]) => (fn [x] (or (= x [[0 0]] [5 5])
-                                                   (= x [[] [5 5]]))))
+      (get-counts replica-1 [j1 j2]) => (fn [x] (or (= (sort x) [[0 0]] [5 5])
+                                                    (= (sort x) [[] [5 5]]))))

 (>!! a-chan :done)
 (close! a-chan)
@@ -139,8 +139,8 @@
   (playback-log (:log env) replica-1 ch 2000))

 (fact "5 peers were reallocated to job 2, task C, 5 peers were reallocated to job 2, task D"
-      (get-counts replica-2 [j1 j2]) => (fn [x] (or (= x [[0 0] [5 5]])
-                                                    (= x [[] [5 5]]))))
+      (get-counts replica-2 [j1 j2]) => (fn [x] (or (= (sort x) [[0 0] [5 5]])
+                                                    (= (sort x) [[] [5 5]]))))

 (>!! c-chan :done)
 (close! c-chan)


verify permissions when tagging or creating thread

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -58,14 +58,18 @@
 (defmethod event-msg-handler :chat/new-message
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (when-let [user-id (get-in ring-req [:session :user-id])]
+    ; TODO: Verify user has permission to do this
     (db/with-conn (db/create-message! ?data))
     (broadcast-thread (?data :thread-id) [user-id])))

 (defmethod event-msg-handler :thread/add-tag
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (when-let [user-id (get-in ring-req [:session :user-id])]
-    (db/with-conn (db/thread-add-tag! (?data :thread-id) (?data :tag-id)))
-    (broadcast-thread (?data :thread-id) [user-id])))
+    (if (db/with-conn (db/user-in-tag-group? user-id (?data :tag-id)))
+      (do (db/with-conn (db/thread-add-tag! (?data :thread-id) (?data :tag-id)))
+          (broadcast-thread (?data :thread-id) [user-id]))
+      ; TODO: indicate permissions error to user?
+      (timbre/warnf "User %s attempted to add a disallowed tag %s" user-id (?data :tag-id)))))

 (defmethod event-msg-handler :user/subscribe-to-tag
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
@@ -83,11 +87,15 @@

 (defmethod event-msg-handler :chat/create-tag
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
-  (db/with-conn (db/create-tag! (select-keys ?data [:id :name :group-id])))
   (when-let [user-id (get-in ring-req [:session :user-id])]
-    (doseq [uid (->> (:any @connected-uids)
-                     (remove (partial = user-id)))]
-      (chsk-send! uid [:chat/create-tag ?data]))))
+    (if (db/with-conn (db/user-in-group? user-id (?data :group-id)))
+      (do (db/with-conn (db/create-tag! (select-keys ?data [:id :name :group-id])))
+          (doseq [uid (->> (:any @connected-uids)
+                           (remove (partial = user-id)))]
+            (chsk-send! uid [:chat/create-tag ?data])))
+      ; TODO: indicate permissions error to user?
+      (timbre/warnf "User %s attempted to create a tag %s in a disallowed group"
+                    user-id (?data :name) (?data :group-id)))))

 (defmethod event-msg-handler :session/start
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]


Fix dependency-order to work with JavaScript strings

This allows running dependency-order once on all sources even when
some of the sources are JavaScript strings.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -292,11 +292,24 @@
             state (reduce dependency-order-visit state deps)]
         (assoc state :order (conj (:order state) file))))))

+(defn- pack-string [s]
+  (if (string? s)
+    {:provides (-provides s)
+     :requires (-requires s)
+     :file (str "from_source_" (gensym) ".clj")
+     ::original s}
+    s))
+
+(defn- unpack-string [m]
+  (or (::original m) m))
+
 (defn dependency-order
   "Topologically sort a collection of dependencies."
   [coll]
-  (let [state (build-index coll)]
-    (distinct (:order (reduce dependency-order-visit (assoc state :order []) (keys state))))))
+  (let [state (build-index (map pack-string coll))]
+    (map unpack-string
+         (distinct
+          (:order (reduce dependency-order-visit (assoc state :order []) (keys state)))))))

 ;; Compile
 ;; =======
@@ -591,13 +604,15 @@
   (let [requires (mapcat -requires inputs)
         required-cljs (remove (set inputs) (cljs-dependencies opts requires))
         required-js (js-dependencies opts (set (concat (mapcat -requires required-cljs) requires)))]
-    (concat (map #(-> (javascript-file (:foreign %)
-                                       (or (:url %) (io/resource (:file %)))
-                                       (:provides %)
-                                       (:requires %))
-                      (assoc :group (:group %))) required-js)
-            required-cljs
-            inputs)))
+    (cons (javascript-file nil (io/resource "goog/base.js") ["goog"] nil)
+          (dependency-order
+           (concat (map #(-> (javascript-file (:foreign %)
+                                              (or (:url %) (io/resource (:file %)))
+                                              (:provides %)
+                                              (:requires %))
+                             (assoc :group (:group %))) required-js)
+                   required-cljs
+                   inputs)))))

 (comment
   ;; add dependencies to literal js
@@ -861,9 +876,7 @@
                      [(-compile (io/resource "cljs/nodejscli.cljs") all-opts)]))
         js-sources (if (coll? compiled)
                      (apply add-dependencies all-opts compiled)
-                     (add-dependencies all-opts compiled))
-        js-sources (cons (javascript-file nil (io/resource "goog/base.js") ["goog"] nil)
-                         (dependency-order js-sources))]
+                     (add-dependencies all-opts compiled))]
     (if (:optimizations all-opts)
       (->> js-sources
            (apply optimize all-opts)


read generated source-map and decode it, comments about next step

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -35,8 +35,10 @@
   "
   (:require [cljs.compiler :as comp]
             [cljs.analyzer :as ana]
+            [cljs.source-map :as sm]
             [clojure.java.io :as io]
-            [clojure.string :as string])
+            [clojure.string :as string]
+            [clojure.data.json :as json])
   (:import java.io.File
            java.io.BufferedInputStream
            java.net.URL
@@ -699,7 +701,12 @@
         (when-let [name (:source-map opts)]
           (let [out (io/writer name)]
             (.appendTo (.getSourceMap closure-compiler) out name)
-            (.close out)))
+            (.close out))
+          (let [source-map (-> (io/file name) slurp
+                               json/read-json sm/decode)]
+            ;; loop over the source maps from compiler & merge maps
+            ;; final source map from merged map
+            ))
         source)
       (report-failure result))))


CLJS-1079: add way to execute arbitrary fn upon watch build completion

`cljs.closure/watch` - Move try/catch logic into local `buildf`, switch to
catch `Throwable`. Support `:watch-fn` option.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1450,7 +1450,8 @@
 (defn watch
   "Given a source directory, produce runnable JavaScript. Watch the source
    directory for changes rebuliding when necessary. Takes the same arguments as
-   cljs.closure/build."
+   cljs.closure/build in addition to :watch-fn, a function of no arguments to
+   run after a successful build."
   ([source opts]
     (watch source opts
       (if-not (nil? env/*compiler*)
@@ -1461,11 +1462,16 @@
           fs (.getFileSystem path)
           service (.newWatchService fs)]
       (letfn [(buildf []
-                (let [start (System/nanoTime)]
-                  (build source opts compiler-env)
-                  (println "... done. Elapsed"
-                    (/ (unchecked-subtract (System/nanoTime) start) 1e9) "seconds")
-                  (flush)))
+                (try
+                  (let [start (System/nanoTime)]
+                    (build source opts compiler-env)
+                    (println "... done. Elapsed"
+                      (/ (unchecked-subtract (System/nanoTime) start) 1e9) "seconds")
+                    (flush))
+                  (when-let [f (:watch-fn opts)]
+                    (f))
+                  (catch Throwable e
+                    (.printStackTrace e))))
               (watch-all [^Path root]
                 (Files/walkFileTree root
                   (reify
@@ -1501,10 +1507,7 @@
                       (seq (.pollEvents key)))
                 (println "Change detected, recompiling...")
                 (flush)
-                (try
-                  (buildf)
-                  (catch Exception e
-                    (.printStackTrace e))))
+                (buildf))
               (recur key))))))))

 (comment
@@ -1514,7 +1517,10 @@
      :output-dir "samples/hello/out"
      :cache-analysis true
      :source-map true
-     :verbose true})
+     :verbose true
+     :watch-fn
+     (fn []
+       (println "Success!"))})
   )

 ;; =============================================================================


fail fast & when accept re and failed secondary preds

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -461,7 +461,7 @@
   conjunction of the predicates, and any conforming they might perform."
   [re & preds]
   (let [pv (vec preds)]
-    `(amp-impl ~re ~pv '~pv)))
+    `(amp-impl ~re ~pv '~(mapv res pv))))

 (defmacro conformer
   "takes a predicate function with the semantics of conform i.e. it should return either a
@@ -1142,9 +1142,7 @@
           ::amp (c/and (accept-nil? p1)
                        (c/or (noret? p1 (preturn p1))
                              (let [ret (-> (preturn p1) (and-preds ps (next forms)))]
-                               (if (= ret ::invalid)
-                                 nil
-                                 ret))))
+                               (not= ret ::invalid))))
           ::rep (c/or (identical? p1 p2) (accept-nil? p1))
           ::pcat (every? accept-nil? ps)
           ::alt (c/some accept-nil? ps))))
@@ -1209,7 +1207,11 @@
             nil (let [ret (dt p x p)]
                   (when-not (= ::invalid ret) (accept ret)))
             ::amp (when-let [p1 (deriv p1 x)]
-                    (amp-impl p1 ps forms))
+                    (if (= ::accept (::op p1))
+                      (let [ret (-> (preturn p1) (and-preds ps (next forms)))]
+                        (when-not (= ret ::invalid)
+                          (accept ret)))
+                      (amp-impl p1 ps forms)))
             ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret})
                          (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x)))
             ::alt (alt* (map #(deriv % x) ps) ks forms)


updaging application.edn location

updaging application.edn location

--- src/clj/ohds/service.clj
+++ src/clj/ohds/service.clj
@@ -8,7 +8,7 @@
   (:import (java.time LocalDateTime)))

-(def config (edn/read-string (slurp "/workspace/src/openhds/ohds/application.edn")))
+(def config (edn/read-string (slurp "application.edn")))
 (def apihost (:apihost config))
 (def apiuser (:apiuser config))
 (def apipass (:apipass config))


Fix: escape $ sign in compose if generated from application state

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -1146,7 +1146,9 @@

 (defn stack-compose
   [stack-name]
-  (some-> (stack stack-name) (->compose) (->yaml)))
+  (let [yaml (some-> (stack stack-name) (->compose) (->yaml))]
+    (when yaml
+      (str/replace yaml "$" "$$"))))

 (defn service-compose
   [service-name]


More docstrings, half way through follow.

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -45,7 +45,7 @@

 ;TODO - doc string
 (defmacro spotify-api-call
-  ""
+  "Creates a function f with doc-string d that calls the http-verb verb for url url."
   [f verb url doc-string]
   `(defn ~f
      ~doc-string
@@ -176,12 +176,34 @@
     :limit is the maxium number of tracks to return, default is 20.
     :offset is the index of the first track to return, default is 0.

-    Example: (get-a-categorys-playlist {:category_id \"dinner\" :country \"SE\" :locale \"sv_SE\"} \"BQBw-JtC..._7GvA\") ")
+    Example: (get-a-categorys-playlist {:category_id \"dinner\" :country \"SE\" :locale \"sv_SE\" :limit 50 :offset 50} \"BQBw-JtC..._7GvA\") ")

 ;Follow
-(spotify-api-call get-users-followed-artists client/get (str spotify-api-url "me/following") "")
-(spotify-api-call follow-artists-or-users client/put (str spotify-api-url "me/following") "")
-(spotify-api-call unfollow-artists-or-users client/delete (str spotify-api-url "me/following") "")
+(spotify-api-call get-users-followed-artists client/get (str spotify-api-url "me/following")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory key in m is :type, optional keys are :limit and :after.
+    :type has to be set to \"artist\".
+    :limit is the maxium number of items to return, default is 20.
+    :after the last artist id retrieved from a previous request. Use this to get next set of artists.
+
+    Example: (get-users-followed-artists {:type \"artist\" :limit 50 :offset 50} \"BQBw-JtC..._7GvA\") ")
+
+(spotify-api-call follow-artists-or-users client/put (str spotify-api-url "me/following")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory key in m is :type and :ids.
+    :type has to be set to \"artist\" or \"user\".
+    :ids has to be a comma separated list of users or artists.
+
+    Example: (follow-artists-or-users {:type \"artist\" :ids \"2933wDUojoQmvqSdTAE5NB,1AUCkAIfT6Ig8lOegDGK3Z\" } \"BQBw-JtC..._7GvA\")")
+
+(spotify-api-call unfollow-artists-or-users client/delete (str spotify-api-url "me/following")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory key in m is :type and :ids.
+    :type has to be set to \"artist\" or \"user\".
+    :ids has to be a comma separated list of users or artists.
+
+    Example: (unfollow-artists-or-users {:type \"artist\" :ids \"0uCCBpmg6MrPb1KY2msceF,1WsMRWV5KEC2AxpYkeb2Cf\" } \"BQBw-JtC..._7GvA\")")
+
 (spotify-api-call user-following-artists-or-users? client/get (str spotify-api-url "me/following/contains") "")
 (spotify-api-call follow-a-playlist client/put (str spotify-api-url "users/owner_id/playlists/playlist_id/followers") "")
 (spotify-api-call unfollow-a-playlist client/delete (str spotify-api-url "users/owner_id/playlists/playlist_id/followers") "")
@@ -214,3 +236,4 @@
 ;Tracks
 (spotify-api-call get-a-track client/get (str spotify-api-url "tracks/id") "")
 (spotify-api-call get-several-tracks client/get (str spotify-api-url "tracks") "")
+


Cleaning up emit :fn

Cleaning up emit :fn

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -512,8 +512,8 @@
     (emits "func(")
     (emit-fn-params params)
     (emitln (when (seq params) " interface{}") ") interface{} {")
-    #_(when type
-        (emitln "var self__ = this"))
+    ;; (when type
+    ;;   (emitln "var self__ = this"))
     (when recurs (emitln "for {"))
     (emits expr)
     (when recurs
@@ -525,73 +525,22 @@
   [{:keys [type name variadic params expr env recurs max-fixed-arity] :as f}]
   (let [varargs (string/join "_" (map :name params))]
     (emit-wrap env
-               (emits "func(")
-               (emitln varargs " ...interface{}" ") interface{} {")
-               #_(when type
-                   (emitln "var self__ = this"))
-               (doseq [[idx p] (map-indexed vector (butlast params))]
-                 (emitln "var " p " = " varargs "[" idx "]"))
-               (emitln "var " (last params) " = " varargs "[" max-fixed-arity ":]") ;; this should be an ArraySeq
-               (emitln (string/join ", " (repeat (count params) "_"))
-                       " = "
-                       (string/join ", " (map :name params)))
-               (when recurs (emitln "for {"))
-               (emits expr)
-               (when recurs
-                 (emitln "break")
-                 (emitln "}"))
-               (emits "}")))
-
-  #_(emit-wrap env
-               (let [name (or name (gensym))
-                     mname (munge name)
-                     delegate-name (str mname "__delegate")]
-                 (emitln "func() { ")
-                 (emits "var " delegate-name " = func (")
-                 (doseq [param params]
-                   (emit param)
-                   (when-not (= param (last params)) (emits ",")))
-                 (emits " interface{}) interface{} {")
-                 (when recurs (emitln "for {"))
-                 (emits expr)
-                 (when recurs
-                   (emitln "break")
-                   (emitln "}"))
-                 (emitln "}")
-
-                 (emitln "var " mname " = func (" (comma-sep
-                                                   (if variadic
-                                                     (butlast params)
-                                                     params))
-                         (when (seq (if variadic
-                                      (butlast params)
-                                      params)) " interface{},")
-                         (when variadic " arguments ...interface{}") ") interface{} {")
-                 (when type
-                   (emitln "var self__ = this"))
-                 (when variadic
-                   (emits "var ")
-                   (emit (last params))
-                   (emitln " = nil")
-                   (emitln "if (len(arguments) > 0) {")
-                   (emits "  ")
-                   (emit (last params))
-                   (emits " = Array_seq(arguments,0)")
-                   (emitln "} "))
-                 (emits "return " delegate-name "(this,")
-                 (doseq [param params]
-                   (emit param)
-                   (when-not (= param (last params)) (emits ",")))
-                 (emits ")")
-                 (emitln "}")
-
-                 (emitln mname ".cljs__lang__maxFixedArity = " max-fixed-arity)
-                 (emits mname ".cljs__lang__applyTo = ")
-                 (emit-apply-to (assoc f :name name))
-                 (emitln)
-                 (emitln mname ".cljs__core__IFn___invoke__arity__variadic = " delegate-name)
-                 (emitln "return " mname)
-                 (emitln "}()"))))
+      (emits "func(")
+      (emitln varargs " ...interface{}" ") interface{} {")
+      ;; (when type
+      ;;   (emitln "var self__ = this"))
+      (doseq [[idx p] (map-indexed vector (butlast params))]
+        (emitln "var " p " = " varargs "[" idx "]"))
+      (emitln "var " (last params) " = " varargs "[" max-fixed-arity ":]") ;; this should be an ArraySeq
+      (emitln (string/join ", " (repeat (count params) "_"))
+              " = "
+              (string/join ", " (map :name params)))
+      (when recurs (emitln "for {"))
+      (emits expr)
+      (when recurs
+        (emitln "break")
+        (emitln "}"))
+      (emits "}"))))

 (defmethod emit* :fn
   [{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
@@ -608,20 +557,12 @@
         (when-not (= :return (:context env))
           (emits "return ")))
       (let [name (or name (gensym))
-            mname (go-public (munge name))
-            maxparams (apply max-key count (map :params methods))
-            mmap (into {}
-                       (map (fn [method]
-                              [(munge (symbol (str mname "__" (count (:params method)))))
-                               method])
-                            methods))
-            ms (sort-by #(-> % second :params count) (seq mmap))]
+            mname (go-public (munge name))]
         (when (= :return (:context env))
           (emits "return "))
         (emitln "func(" mname " *AFn) *AFn {")
         (emits "return Fn(" mname ", ")
         (loop [[meth & methods] methods]
-          #_(emits "var " n " = ")
           (if (:variadic meth)
             (emit-variadic-fn-method meth)
             (emit-fn-method meth))
@@ -629,42 +570,6 @@
             (emits ", ")
             (recur methods)))
         (emitln ").(*AFn)")
-        #_ (emitln mname " = func(arguments ...interface{}) interface{} {" )
-        #_(emitln mname " = func(" (comma-sep
-                                    (if variadic
-                                      (butlast maxparams)
-                                      maxparams))
-                  (when (seq (if variadic
-                               (butlast maxparams)
-                               maxparams)) " interface{},")
-                  (when variadic " arguments ...interface{}") ") interface{} {")
-        #_ (when variadic
-          (emits "var ")
-          (emit (last maxparams))
-          (emitln " = var_args"))
-        #_(emitln "switch(len(arguments)){")
-        #_(doseq [[n meth] ms]
-          (if (:variadic meth)
-            (do (emitln "default:")
-                (emitln "return " n "_cljs__core__IFn___invoke__arity__variadic("
-                        (comma-sep (butlast maxparams))
-                        (when (> (count maxparams) 1) ", ")
-                        "Array_seq(arguments, " max-fixed-arity "))"))
-            (let [pcnt (count (:params meth))]
-              (emitln "case " pcnt ":")
-              (emitln "return " n "(" (if (zero? pcnt) nil
-                                          (list (comma-sep (take pcnt maxparams)))) ")"))))
-        #_(emitln "}")
-        #_(emitln "panic(js.Error{fmt.Sprint(\"Invalid arity: \", len(arguments))})")
-        #_(emitln "}")
-        #_(when variadic
-          (emitln mname "_cljs__lang__maxFixedArity = " max-fixed-arity)
-          (emitln mname "_cljs__lang__applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) "_cljs__lang__applyTo"))
-        #_(doseq [[n meth] ms]
-          (let [c (count (:params meth))]
-            (if (:variadic meth)
-              (emitln mname "_cljs__core__IFn___invoke__arity__variadic = " n "_cljs__core__IFn___invoke__arity__variadic")
-              (emitln mname "_cljs__core__IFn___invoke__arity__" c " = " n))))
         (emitln "}(&AFn{})"))
       (when loop-locals
         (emitln "}(" (comma-sep loop-locals) "))"))))


Experiment with :case-stagnation meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -208,7 +208,7 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
-              #_(if (not (:print-history argmap))
+              (if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :case-stagnation"))
@@ -228,7 +228,7 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
-              (if (not (:print-history argmap))
+              #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :case-stagnation"))


Config selecting routine for CLI user

Config selecting routine for CLI user

--- src/skat/cli.clj
+++ src/skat/cli.clj
@@ -7,7 +7,7 @@
             [skat.game :as game]
             [skat.auction :as auction]
             [skat.ai :as ai])
-  (:import  [skat Bidders Player GameDriver]))
+  (:import  [skat Bidders Configuration Player GameDriver]))
 (set! *warn-on-reflection* true)

 ;;; Players forward declarations
@@ -176,6 +176,16 @@
 (defn select-suit "User selects suit" []
   (select-nth (vec game/suits) suit-str suit-separator))

+(defn select-config "User selects used config" [{ :keys [:winner :cards :bid] }]
+  (let [declarer     winner
+        suit         (.declare-suit ^Player winner cards bid)
+        hand         (.declare-hand ^Player winner cards bid)
+        ouvert       (if hand (.declare-ouvert ^Player winner cards bid))
+        schneider    (.declare-schneider ^Player winner cards bid)
+        schwarz      (if hand (.declare-schwarz ^Player winner cards bid))
+        declared-bid bid]
+    (Configuration. declarer suit hand ouvert schneider schwarz declared-bid)))
+
 ;;; Players

 (def create-cpu-player "Creates computer player" ai/ai-player)
@@ -247,7 +257,7 @@
                                                    (-> result :bid))
                               (show-player-bid-draw))
                             (identity result))))
-                      (declare-game [this bidding] nil))]
+                      (declare-game [this bidding] (select-config bidding)))]
     (game/start-game driver)))

 ;; TODO:


Rewrite contains-all?

Rewrite contains-all?

--- src/str/core.clj
+++ src/str/core.clj
@@ -253,18 +253,12 @@
 (defn ^String contains-all?
   "Return s if s contains all needles."
   ([^String s needles]
-   (loop [needles needles]
-     (if (seq needles)
-       (when (case-sensitive-contains s (first needles))
-         (recur (rest needles)))
-       s)))
+   (when (every? (partial case-sensitive-contains s) needles)
+     s))
   ([^String s needles ignore-case]
    (if ignore-case
-     (loop [needles needles]
-       (if (seq needles)
-         (when (case-insensitive-contains s (first needles))
-           (recur (rest needles)))
-         s))
+     (when (every? (partial case-insensitive-contains s) needles)
+       s)
      (contains-all? s needles))))

 (defn ^String contains-any?


The function third can't throw an exception

--- src/zg/utils.clj
+++ src/zg/utils.clj
@@ -10,12 +10,13 @@
 ;      Pavel Tisnovsky
 ;

-(ns zg.utils)
+(ns zg.utils
+    "Various utility function used by other modules.")

 (defn third
     "Simple utility function - returns third item from a given sequence."
     [coll]
-    (nth coll 2))
+    (nth coll 2 nil))

 (defn substring
     "Call method String.substring()."


handle boolean key components correctly

handle boolean key components correctly

--- src/er_cassandra/key.clj
+++ src/er_cassandra/key.clj
@@ -25,7 +25,7 @@
          record (when (map? record-or-key-value)
                   record-or-key-value)
          dkv (map (fn [k ev]
-                    (or ev (get record k)))
+                    (if (some? ev) ev (get record k)))
                   key
                   key-value)]
      (when (and


commentary for with-constraints

commentary for with-constraints

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -51,7 +51,7 @@

    Similar results would occur for the 2-arity versions of `doubler` and `bad-doubler`.

-   While it's fine to use `partial` directly, it's better to use the `with-contracts` macro
+   While it's fine to use `partial` directly, it's better to use the `with-constraints` macro
    found in this same library.
   "
   [& forms]
@@ -64,7 +64,11 @@
          (rest forms)
          forms)))))

-(defmacro ^{:private true} chain-fn
+(defmacro with-constraints
+  "Takes a target function and a number of contracts and returns a function with the contracts
+   applied to the original.  This is the preferred way to apply a contract previously created
+   using `contract` as the use of `partial` may not work as implementation details change.
+  "
   ([f] f)
   ([f contract] (list 'partial contract f))
   ([f contract & more]


Finished existential quantifier simplification

--- src/formlogic/parser.clj
+++ src/formlogic/parser.clj
@@ -1,11 +1,15 @@
 (ns formlogic.parser
   (:require [instaparse.core :as insta]
-            [clojure.tools.logging :as log]))
-
-(def logic-parser (insta/parser (clojure.java.io/resource "logic.bnf")
-                                :auto-whitespace :standard))
-
-(def nonterms ^{:doc "Vector of all non-terminals"}
+            [clojure.tools.logging :as log]
+            [clojure.zip :as zip]))
+
+(def logic-parser
+  "Main parser for logic expressions."
+  (insta/parser (clojure.java.io/resource "logic.bnf")
+                :auto-whitespace :standard))
+
+(def nonterms
+  "Vector of all non-terminals."
   [:WellFormedFormula
    :QuantifiedFormula
    :Quantifier
@@ -19,23 +23,41 @@
    :Arguments
    :Argument])

-(def nonterms-exclude-simplify #{:Negation :QuantifierNegation})
+(def nonterms-exclude-simplify
+  "These nonterms will not be simplified."
+  #{:Negation :QuantifierNegation})
+
+(defn- -reconstruct-node
+  "Reconstructs node from nonterm key and children."
+  [key children]
+  (into [key] children))

 (defn- -simplify-tree-by
-  [key]
   "Simplifies hiccup format of instaparse parser tree for specified nonterm.
   This is done by removing superfluous levels of nesting from recursive
   elements. For example, [:Disjunction [:Conjunction [:Implication [:Term]]]]
   becomes just [:Term]."
+  [key]
   (fn [& children]
     (if (and (not (contains? nonterms-exclude-simplify key))
              (= (count children) 1))
       ;; Return the only child.
       (first children)
       ;; Don't change anything here.
-      (into [key] children))))
+      (-reconstruct-node key children))))
+
+(defn nonterm?
+   "Tests if node is a nonterminal."
+  ([node]
+   (and (vector? node) (keyword? (first node))))
+  ([node & nonterm-contents]
+     (and (nonterm? node)
+          ;; Only compare first N children, where N is number of additional
+          ;; args specified.
+          (= nonterm-contents (take (count nonterm-contents) node)))))

 (defn simplify-tree
+  "Applies -simplify-tree-by for all nonterms (except excluded)."
   [tree]
   (insta/transform
     ;; This makes a map of :NonTerminal -> simplify-tree-by-:NonTerminal.
@@ -43,13 +65,13 @@

 (defn- -negate-quantifier
   [quantifier]
-  (if (= (first quantifier) :QuantifierNegation)
+  (if (nonterm? quantifier :QuantifierNegation)
     (second quantifier)
     [:QuantifierNegation quantifier]))

 (defn- -negate-formula
   [formula]
-  (if (= (first formula) :QuantifiedFormula)
+  (if (nonterm? formula :QuantifiedFormula)
     (let [[_ quantifier formula] formula]
       ;; This will, in turn, negate the formula in next iteration.
       [:QuantifiedFormula (-negate-quantifier quantifier) formula])
@@ -62,8 +84,6 @@
      (fn [& children]
        (let [[lhs rhs] children]
          [:Disjunction (-negate-formula lhs) rhs]))} tree))
-
-(defn- -reconstruct-node [key children] (into [key] children))

 (defn- -transform-term-negation
   [& children]
@@ -72,13 +92,16 @@
       :Conjunction [:Disjunction (-negate-formula lhs) (-negate-formula rhs)]
       :Disjunction [:Conjunction (-negate-formula lhs) (-negate-formula rhs)]
       :Negation lhs
+      ;; This is a custom rule, used for ~(\\A x) forms. Replace it with form
+      ;; that can be negated in next run with the other rule.
+      :QuantifiedFormula [:QuantifiedFormula (-negate-quantifier lhs) rhs]
       ;; In default case, do nothing - reconstruct original node.
       (-reconstruct-node :Negation children))))

 (defn- -transform-quantifier-negation
   [& children]
   (let [[quantifier formula] children]
-    (if (= (first quantifier) :QuantifierNegation)
+    (if (nonterm? quantifier :QuantifierNegation)
       (let [[[_ foreach-exists literal]] (rest quantifier)]
         (-reconstruct-node :QuantifiedFormula
                            [[:Quantifier
@@ -99,29 +122,96 @@
       result
       (recur result))))

-(defn depth-tree-seq [tree] (tree-seq #(vector? (second %)) rest tree))
-
-(defn walk-tree
-  ([tree f]
-   (walk-tree [] tree (constantly true) f))
-  ([path tree filter-by f]
-   "Walks the syntax tree depth-first, filtering nodes with filter-by, and then
-   applying f to matched nodes (f takes path and node)."
-   (let [tree-seq (depth-tree-seq tree)
-         [subpath matched] (split-with (complement filter-by) tree-seq)
-         path (concat path subpath)]
-     (f path (first matched))
-     (if (empty? (rest matched))
-       nil
-       (recur path (rest matched) filter-by f)))))
+(def example-expr "\\A x { Cigla(x) => ((\\E y {Na(x, y) && ~Piramida(y)}) && (~\\E y {Na(x,y) && Na(y,x) }) && (\\A y { ~Cigla(y) => ~Jednako(x,y)}))}")
+
+(defn quantified-formula? [loc] (nonterm? (zip/node loc) :QuantifiedFormula))
+
+(defn- -extract-bound-literal [loc]
+  (if (quantified-formula? loc)
+    (-> loc zip/down zip/right zip/down zip/right zip/right zip/down zip/right zip/node)
+   nil))
+
+(defn- -extract-quantifier [loc]
+  (if (quantified-formula? loc)
+    (-> loc zip/down zip/right zip/down zip/right zip/down zip/node)
+   nil))
+
+(defn next-quantified-formula [loc quantifier]
+  (if (zip/end? loc)
+    nil
+    (if (= quantifier (zip/node loc))
+      (-> loc zip/up zip/up zip/up)
+      (recur (zip/next loc) quantifier))))
+
+(defn collect-quantifier-bound-atoms
+  ([loc] (collect-quantifier-bound-atoms (zip/up loc) []))
+  ([loc bound-atoms]
+   (if (nil? loc)
+     ;; Reached the root.
+     bound-atoms
+    (recur (zip/up loc)
+      (if (and (quantified-formula? loc) (= :FOREACH (-extract-quantifier loc)))
+        (conj bound-atoms (-extract-bound-literal loc))
+        bound-atoms)))))
+
+(defn replace-literal
+  [literal replacement loc]
+  (letfn [(recursive? [loc]
+            (if (zip/end? loc)
+              false
+              (if (nonterm? (zip/node loc) :LITERAL literal)
+                true
+                (recur (zip/next loc)))))
+          (alter-subtree [loc]
+            (if (zip/end? loc)
+              ;; Grab the whole modified subtree.
+              (zip/root loc)
+              (if (nonterm? (zip/node loc) :LITERAL literal)
+                ;; Replace literal.
+                (recur (zip/next (zip/edit loc (constantly replacement))))
+                ;; No literal here, move on.
+                (recur (zip/next loc)))))]
+    ;; Check for infinite recursion.
+    (if (recursive? (zip/vector-zip replacement))
+      (throw (IllegalArgumentException.
+               (str "Replacement " replacement " contains literal to replace " literal " !")))
+      (zip/edit loc #(alter-subtree (zip/vector-zip %))))))
+
+(def replacement-predicate-index (atom 0))
+(defn next-replacement-predicate! []
+  (str "F" (swap! replacement-predicate-index + 1)))
+
+(defn transform-existential-quantifiers
+  [tree]
+  (let [loc (zip/vector-zip tree)
+        replace-next-existential-formula
+        (fn [loc]
+          (if-let [existential-formula (next-quantified-formula loc :EXISTS)]
+            (let [bound-literal (-extract-bound-literal existential-formula)
+                  bound-atoms (collect-quantifier-bound-atoms existential-formula)
+                  replacement (reduce #(conj %1 (vector :LITERAL %2))
+                                      [:Predicate [:PRED (next-replacement-predicate!)]]
+                                      bound-atoms)
+                  ;; Remove the existential formula and replace it with its
+                  ;; contents.
+                  modified-loc (zip/edit existential-formula
+                                         (constantly (-> existential-formula
+                                                   zip/down
+                                                   zip/right
+                                                   zip/right
+                                                   zip/node)))]
+              ;; We replace all references to the bound-literal with replacement.
+              (recur (replace-literal bound-literal replacement modified-loc)))
+            ;; Nothing more to do.
+            (zip/root loc)))]
+    (replace-next-existential-formula loc)))

 (defn wff->cnf
-  [formula]
   "Converts a well-formed formula in string form to conjuctive-normal-form in
   tree form."
+  [formula]
   (-> (logic-parser formula)
       simplify-tree
       transform-implications
-      transform-negations))
-
-(def example-expr "\\A x { Cigla(x) => ((\\E y {Na(x, y) && ~Piramida(y)}) && (~\\E y {Na(x,y) && Na(y,x) }) && (\\A y { ~Cigla(y) => ~Jednako(x,y)}))}")
+      transform-negations
+      transform-existential-quantifiers))


ich glaube ich kann jetzt prüfen ob GEber valid

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -21,15 +21,10 @@

 (defn sqlquery [name empfaenger]
-
-;(first (jdbc/query mysql-db [(str "select * from konten where Name='" name "'")])))
-(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand - 1 WHERE Kontostand > 0 AND Name = ?" name])
-(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand + 1 WHERE NurZahlen = 0 AND Name = ?" empfaenger])
-;(jdbc/update! mysql-db :konten {:Kontostand 99} ["Name = ?" name]))
-; maybe this sets the guthaben to 99
-(jdbc/execute! mysql-db ["insert into transaktionen_geberkonten2nehmerkonten (betrag) select MIN(geberkonten.stand) from geberkonten where geberkonten.nr in ( ? , '00000000-0000-0000-0000-00000025')" name])
-(jdbc/execute! mysql-db ["update transaktionen_geberkonten2nehmerkonten set sender = ? , empfaenger = ?  where transaktions_id = last_insert_id()" name empfaenger])
-;(jdbc/execute! mysql-db ["update geberkonten set stand = stand - 25 where geberkonten.nr = '?' AND stand > 0" name])
+  (jdbc/execute! mysql-db ["insert into transaktionen_geberkonten2nehmerkonten (betrag) select MIN(geberkonten.stand) from geberkonten where geberkonten.nr in ( ? , '00000000-0000-0000-0000-00000025')" name])
+  (jdbc/execute! mysql-db ["insert into transaktionen_geberkonten2nehmerkonten (valid) select valid from geberkonten where geberkonten.nr =?" name])
+  (jdbc/update! mysql-db :transaktionen_geberkonten2nehmerkonten {:sender name, :empfaenger empfaenger, :valid 0} (sql/where {:valid 1}))
+  (jdbc/execute! mysql-db ["update geberkonten set stand = stand - 25 where geberkonten.nr = ? AND stand > 0" name])
 )


Update every 1/2 second to reduce CPU usage.

--- ui/src/ui/core.cljs
+++ ui/src/ui/core.cljs
@@ -40,7 +40,7 @@
           (transact! data :elapsed-seconds #(mod interval-seconds 60))
           (transact! data :elapsed-minutes #(mod (/ interval-seconds 60) 60))
           (transact! data :elapsed-hours #(mod (/ interval-seconds 60 60) 24))
-          (<! (timeout 10))
+          (<! (timeout 500))
           (recur))))
     IRenderState
     (render-state [_ _]


Some more cosmetics for EL_gfp

Some more 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
@@ -68,7 +68,7 @@
   [tbox concepts]
   (when (empty? concepts)
     (illegal-argument "EL-gfp-lcs called with no concepts."))
-  (loop [tbox tbox,
+  (loop [tbox     tbox,
          concepts concepts]
     (if (= 1 (count concepts))
       [tbox (first concepts)]
@@ -80,7 +80,7 @@
             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))
+               (conj (vec (nthnext concepts 2))
                      new-target))))))

 (defn EL-gfp-msc


Added note to ai.clj

Added note to ai.clj

--- src/skat/ai.clj
+++ src/skat/ai.clj
@@ -2,6 +2,14 @@
   (:require [skat])
   (:import  [skat Player]))
 (set! *warn-on-reflection* true)
+
+; Implementation (when done) ideally should make use of knowlledge passed as
+; PlayerSituation - PlayerKnowledge contains information on currently owned
+; cards, cards that we used before and cards that each player took during the
+; deal. With this information it should be often possible to deduce what cards
+; other players have or have not. Together with information about played game
+; type it should be possible to point some prefered allowed card to play in the
+; trick.

 (defn ai-player "Creates computer player" [id]
   (reify Player


Remove stray println.

Remove stray println.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -658,7 +658,6 @@
   (advanced? [this]
     advanced)
   (get-lifecycle [this]
-    (println "GETTING" (.get idx) "from" nstates)
     (aget lifecycle-names (.get idx)))
   (heartbeat! [this]
     (let [curr-time (System/nanoTime)]


Remove unused nses.

Remove unused nses.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -14,14 +14,12 @@
             [onyx.log.entry :as entry]
             [clojure.set]
             [onyx.log.replica]
-            [onyx.messaging.common :as mc]
             [onyx.messaging.messenger-state :as ms]
             [onyx.messaging.protocols.messenger :as m]
             [onyx.messaging.protocols.publisher :as pub]
             [onyx.messaging.protocols.endpoint-status :as endpoint-status]
             [onyx.messaging.protocols.subscriber :as sub]
             [onyx.messaging.protocols.status-publisher :as status-pub]
-            [onyx.monitoring.measurements :refer [emit-latency emit-latency-value]]
             [onyx.monitoring.metrics-monitoring :as metrics-monitoring :refer [update-timer-ns!]]
             [onyx.peer.grouping :as g]
             [onyx.peer.constants :refer [initialize-epoch]]
@@ -617,8 +615,7 @@
                    (fn [e]
                      (let [{:keys [exception segment]} (ex-data e)]
                        (throw (r/maybe-attach-segment exception (:onyx.core/task-id event) segment))))
-                   (fn [e]
-                     e))]
+                   (fn [e] e))]
     (fn [state]
       (transform/apply-fn a-fn f throw-fn state))))


Fix needs the inverse.

Fix needs the inverse.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -269,7 +269,7 @@
 (defn apply-fn-bulk [f {:keys [onyx.core/batch] :as event}]
   ;; Bulk functions intentionally ignore their outputs.
   (let [segments (map :message batch)]
-    (when-not (seq segments) (f segments))
+    (when (seq segments) (f segments))
     (assoc
       event
       :onyx.core/results


arg-or-default can be implemented via get

--- src/onyx/static/default_vals.clj
+++ src/onyx/static/default_vals.clj
@@ -44,7 +44,4 @@
    :onyx.messaging/ack-daemon-clear-interval 15000})

 (defn arg-or-default [k opts]
-  (let [opts-val (get opts k)]
-    (if (nil? opts-val)
-      (get defaults k)
-      opts-val)))
+  (get opts k (get defaults k)))


Include peer count in cluster column

Include peer count in cluster column

--- src/cljs/onyx_dashboard/components/deployment.cljs
+++ src/cljs/onyx_dashboard/components/deployment.cljs
@@ -52,7 +52,7 @@
 (defcomponent deployment-peers [deployment owner]
   (render [_]
           (p/panel
-            {:header (om/build section-header-collapsible {:text "Deployment Peers"} {})
+            {:header (om/build section-header-collapsible {:text (str "Cluster Peers (" (count (:peers deployment)) ")")} {})
              :collapsible? true
              :bs-style "primary"}
             (if (and (:id deployment)


also fix creation of root categories

also fix creation of root categories

--- src/main/cljs/chessdojo/views/browser.cljs
+++ src/main/cljs/chessdojo/views/browser.cljs
@@ -24,6 +24,6 @@

 (defn browser []
   [:div
-   [:span.pull-right [:a {:href "#taxon-editor" :data-toggle "modal" :on-click #(init-taxon (new-taxon) nil)} "New root taxon"]]
+   [:a {:href "#taxon-editor" :data-toggle "modal" :on-click #(reset! cst/current-taxon (init-taxon (new-taxon) nil) )} "New root taxon"]
    [:hr]
    (map render-single-taxon @cst/taxonomy)])


AW + FM | 388 | Added error logging for stonecutter workflow

--- src/objective8/front_end/workflows/stonecutter.clj
+++ src/objective8/front_end/workflows/stonecutter.clj
@@ -8,6 +8,7 @@
             [objective8.front-end.front-end-requests :as front-end]))

 (defn invalid-configuration-handler [_]
+  (log/error "Invalid Stonecutter configuration provided")
   (response/redirect (utils/path-for :fe/error-configuration)))

 (defn stonecutter-sign-in [{:keys [stonecutter-config] :as request}]


temporarily remove buf-rd checking -- needs to be more lenient see also buf-wr

--- src/overtone/sc/machinery/ugen/metadata/buf_io.clj
+++ src/overtone/sc/machinery/ugen/metadata/buf_io.clj
@@ -53,7 +53,7 @@
                :default 2
                :doc "1 means no interpolation, 2 is linear, 4 is cubic interpolation"}]
        :summary "Read the contents of a buffer at a specified index"
-       :check (when-ar (nth-input-ar 2))
+       ;; :check (when-ar (nth-input-ar 2))
        :doc "reads the contents of a buffer at a given index."}

       {:name "BufWr",


I didn't realize that tracker didn't have a transitive dependency

--- src/midje/internal_ideas/project_state.clj
+++ src/midje/internal_ideas/project_state.clj
@@ -1,6 +1,6 @@
 (ns ^{:doc "What we know about the changing project file/namespace tree."}
   midje.internal-ideas.project-state
-  (:use [midje.util.form-utils :only [invert]]
+  (:use [midje.util.form-utils :only [invert separate-by]]
         [swiss-arrows.core :only [-<>]]
         [bultitude.core :only [namespaces-in-dir namespaces-on-classpath]])
   (:require [midje.util.ecosystem :as ecosystem]
@@ -87,11 +87,20 @@
      (when (not (empty? namespaces))
        (recur (shorten-ns-list-by-trying-first namespaces))))))

+ ;; TODO: clojure.tools.namespace also finds a transitive closure when it finds
+ ;; the namespaces to reload, but I don't see quite how to hook into that mechanism,
+ ;; so I roll my own.
  (defn mkfn:clean-dependents [state-tracker]
-   (fn [namespace possible-dependents]
-     (let [actual-dependents (set (get-in state-tracker [deps-key :dependents namespace]))]
-       (remove actual-dependents possible-dependents))))
-
+   (fn [failing-namespace other-namespaces]
+     (loop [[root-to-handle & roots-to-handle-later] [failing-namespace]
+            surviving-namespaces other-namespaces]
+       (if (nil? root-to-handle)
+         surviving-namespaces
+         (let [actual-dependent-set (set (get-in state-tracker [deps-key :dependents root-to-handle]))
+               [new-roots unkilled-descendents] (separate-by actual-dependent-set surviving-namespaces)]
+           (recur (concat roots-to-handle-later new-roots)
+                  unkilled-descendents))))))
+
  (defn react-to-tracker! [state-tracker]
    (let [namespaces (load-key state-tracker)]
      (when (not (empty? namespaces))


(TK-272) Inlining deny-all map

(TK-272) Inlining deny-all map

--- src/puppetlabs/trapperkeeper/authorization/acl.clj
+++ src/puppetlabs/trapperkeeper/authorization/acl.clj
@@ -76,17 +76,7 @@
   [pattern]
   (-> pattern (str/lower-case) (str/split #"\.") reverse vec))

-(def allow-all {:auth-type :allow
-                :type :allow-all
-                :qualifier :exact
-                :length nil
-                :pattern []})
-
-(def deny-all {:auth-type :deny
-               :type :regex
-               :qualifier :exact
-               :length nil
-               :pattern #"^*$"})
+(def allow-all { :auth-type :allow :type :allow-all :qualifier :exact :length nil :pattern [] })

 (schema/defn new-domain :- Entry
   "Creates a new ACE for a domain"
@@ -98,7 +88,11 @@

     ; global deny
     (and (= "*" pattern) (= type :deny))
-    deny-all
+    {:auth-type :deny
+     :type :regex
+     :qualifier :exact
+     :length nil
+     :pattern #"^*$"}

     ; exact domain
     (re-matches #"^(\w[-\w]*\.)+[-\w]+$" pattern)


Replace reduce-concat with mapcat

Replace reduce-concat with mapcat

--- src/less4clj/webjars.clj
+++ src/less4clj/webjars.clj
@@ -12,20 +12,17 @@
 (defn list-assets [classloader]
   (->> (.getResources classloader WEBJARS_PATH_PREFIX)
        enumeration-seq
-       (reduce
-         (fn [assets url]
-           (concat
-             assets
-             (case (.getProtocol url)
-               "jar"
-               (let [[_ jar] (re-find #"^file:(.*\.jar)\!/.*$" (.getPath url))]
-                 (->> (enumeration-seq (.entries (JarFile. (io/file jar))))
-                      (remove #(.isDirectory %))
-                      (map #(.getName %))
-                      (filter #(.startsWith % WEBJARS_PATH_PREFIX))))
+       (mapcat
+         (fn [url]
+           (case (.getProtocol url)
+             "jar"
+             (let [[_ jar] (re-find #"^file:(.*\.jar)\!/.*$" (.getPath url))]
+               (->> (enumeration-seq (.entries (JarFile. (io/file jar))))
+                    (remove #(.isDirectory %))
+                    (map #(.getName %))
+                    (filter #(.startsWith % WEBJARS_PATH_PREFIX))))

-               (util/dbug "Skipping url: %s\n" url))))
-         [])
+             (util/dbug "Skipping url: %s\n" url))))
        set))

 (def ^:private webjars-pattern


Fixed flats 'n sharps.

Fixed flats 'n sharps.

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -61,7 +61,7 @@
 (def bass
   (let [line
           {:time (repeat 24 1)
-           :pitch (mapcat (partial repeat 3) (concat (run 0 -3) (run -5 -3) [0 7]))}
+           :pitch (mapcat (partial repeat 3) (concat (run 0 -3) (run -5 -3) [0 0]))}
         lower-note #(- % 7)
         lower-melody (update :pitch #(connect lower-note %))]
    (-> line melody lower-melody)))
@@ -77,15 +77,20 @@
 (defn transpose [interval] (update :pitch #(shift % interval)))
 (def canone-alla-quarta (reduce connect [(after 3) (transpose -3) mirror]))

+(defn sharps [notes fpitches] #(if (some (partial = %) notes) (-> % fpitches inc) (fpitches %)))
+(defn flats [notes fpitches] #(if (some (partial = %) notes) (-> % fpitches dec) (fpitches %)))
+
 (defn play# []
   (let [from-now #(translate % 0 (now))
         beat (from-now (bpm 100))
         with-beat (update :time (partial connect beat))
         in-key (update :pitch (partial connect g-major))
+        with-bass-accidentals (update :pitch (partial sharps [8]))
+        with-leader-accidentals (connect (update :pitch (partial sharps [22 32])) (update :pitch (partial flats [37])))
         after-a-half (after 1/2)]
-    (-> bass in-key with-beat melody#)
+    (-> bass in-key with-bass-accidentals with-beat melody#)
     (-> leader after-a-half canone-alla-quarta in-key with-beat melody#)
-    (-> leader after-a-half in-key with-beat melody#)
+    (-> leader after-a-half in-key with-leader-accidentals with-beat melody#)
     ))

 (play#)


Properly lock stage for gset.

Properly lock stage for gset.

--- src/replikativ/crdt/simple_gset/stage.cljc
+++ src/replikativ/crdt/simple_gset/stage.cljc
@@ -4,43 +4,46 @@
             [replikativ.environ :refer [*id-fn*]]
             [replikativ.crdt.simple-gset.core :as gset]
             [kabel.platform-log :refer [debug info warn]]
-            #?(:clj [full.async :refer [go-try <?]])
+            #?(:clj [full.async :refer [go-try <? put?]])
             [clojure.set :as set]
             #?(:clj [clojure.core.async :as async
                      :refer [>! timeout chan put! sub unsub pub close!]]
                :cljs [cljs.core.async :as async
                       :refer [>! timeout chan put! sub unsub pub close!]]))
-  #?(:cljs (:require-macros [full.async :refer [go-try <?]])))
+  #?(:cljs (:require-macros [full.async :refer [go-try <? put?]])))

 (defn create-simple-gset!
   [stage & {:keys [user is-public? description id]
             :or {is-public? false
                  description ""}}]
-  (go-try (let [user (or user (get-in @stage [:config :user]))
+  (go-try (let [{{:keys [sync-token]} :volatile} @stage
+                _ (<? sync-token)
+                user (or user (get-in @stage [:config :user]))
                 ngset (assoc (gset/new-simple-gset)
                              :public is-public?
-                              :description description)
+                             :description description)
                 id (or id (*id-fn*))
                 identities {user #{id}}
-                new-stage (swap!
-                           stage
-                           (fn [old]
-                             (-> old
-                                (assoc-in [user id] ngset)
-                                (update-in [:config :subs user] #(conj (or % #{}) id)))))]
+                new-stage (swap! stage
+                                 (fn [old]
+                                   (-> old
+                                       (assoc-in [user id] ngset)
+                                       (update-in [:config :subs user] #(conj (or % #{}) id)))))]
             (debug "creating new SimpleGSet for " user "with id" id)
             (<? (subscribe-crdts! stage (get-in new-stage [:config :subs])))
-            (locking stage
-              (->> (<? (sync! new-stage [user id]))
-                   (cleanup-ops-and-new-values! stage identities)))
+            (->> (<? (sync! new-stage [user id]))
+                 (cleanup-ops-and-new-values! stage identities))
+            (put? sync-token :stage)
             id)))

 (defn add!
   [stage [user simple-gset-id] element]
   (go-try
-   (locking stage
-     (->> (<?? (sync! (swap! stage #(update-in % [user simple-gset-id] gset/add element)
-                            {user #{simple-gset-id}})))
-          (cleanup-ops-and-new-values! stage {user #{simple-gset-id}})))))
+   (let [{{:keys [sync-token]} :volatile} @stage
+         _ (<? sync-token)]
+     (->> (<? (sync! (swap! stage #(update-in % [user simple-gset-id] gset/add
+                                              element) {user #{simple-gset-id}})))
+          (cleanup-ops-and-new-values! stage {user #{simple-gset-id}}))
+     (put? sync-token :stage))))


handle failure better

handle failure better

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/plugins.cljs
+++ src/lt/objs/plugins.cljs
@@ -95,9 +95,13 @@

 (defn plugin-edn [dir]
   (when-let [content (files/open-sync (files/join dir "plugin.edn"))]
-    (-> (EOF-read (:content content))
-        (assoc :dir dir)
-        (validate "plugin.edn"))))
+    (try
+      (-> (EOF-read (:content content))
+          (assoc :dir dir)
+          (validate "plugin.edn"))
+      (catch :default e
+        (console/error "FAILED to load plugin.edn: " dir)))
+    ))

 (defn plugin-json [dir]
   (when-let [content (files/open-sync (files/join dir "plugin.json"))]


Add ajax error handler.

Add ajax error handler.

--- src-cljs/kixi/hecuba/menu.cljs
+++ src-cljs/kixi/hecuba/menu.cljs
@@ -1,11 +1,9 @@
 (ns kixi.hecuba.menu
   (:require [ajax.core :refer (GET)]
+            [kixi.hecuba.common :refer (log) :as common]
+            [kixi.hecuba.tabs.slugs :as slugs]
             [om.core :as om :include-macros true]
-            [kixi.hecuba.tabs.slugs :as slugs]
             [sablono.core :as html :refer-macros [html]]))
-
-
-(enable-console-print!)

 (def menu-model (atom {:menu [ {:pathname "/app" :text "Main"}
                                {:pathname "/search" :text "Search"}
@@ -36,5 +34,6 @@
             :init-state {:pathname (-> js/window .-location .-pathname)}})
   (GET "/4/whoami"
        {:handler (fn [x] (swap! menu-model assoc :whoami x))
+        :error-handler (fn [x] (log "Error retrieving whoami data."))
         :response-format :json
         :keywords? true}))


WIP...

WIP...

--- src/4clojure/prime_numbers.clj
+++ src/4clojure/prime_numbers.clj
@@ -13,14 +13,28 @@
   [n])

+;; (let [l (range 2 (* 5 5))
+;;       p (first l)]
+;;   (reduce #(conj (remove (fn [x] zero? (mod x p)) l) p)))
+
+(loop [l (range 2 (* 5 5))
+       ll []
+       p 2]
+  (let [lll (sort (conj (remove #(zero? (mod % p)) l) p))]
+    (if p
+      (recur lll (next lll) (fnext lll))
+      lll)))
+
+(first [1])
+
+
 (let [l (range 2 (* 5 5))
-      p (first l)]
-  (reduce #(conj (remove (fn [x] zero? (mod x p)) l) p))
-
+      p (second l)]
+  (conj (remove #(zero? (mod % p)) l) p))

 (= (__ 2) [2 3])

 (= (__ 5) [2 3 5 7 11])

-(= (last (__ 100)) 541)+(= (last (__ 100)) 541)


add unit test

add unit test

--- storm-core/test/clj/backtype/storm/config_test.clj
+++ storm-core/test/clj/backtype/storm/config_test.clj
@@ -168,3 +168,24 @@
                       (catch Exception e e)))))
         (is (thrown-cause? java.lang.IllegalArgumentException
           (.validateField validator "test" 42)))))))
+
+(deftest test-absolute-storm-local-dir
+  (let [storm-home-key "storm.home"
+        old-storm-home (System/getProperty storm-home-key)
+        conf-relative {STORM-LOCAL-DIR "storm-local"}
+        conf-absolute {STORM-LOCAL-DIR
+                       (if on-windows?
+                         "C:\\storm-local"
+                         "/var/storm-local")}]
+    (try
+      (System/setProperty storm-home-key (if on-windows? "C:\\storm-home" "/usr/local/storm-home"))
+      (testing
+        "for relative path"
+        (is (= (str (System/getProperty storm-home-key) file-path-separator (conf-relative STORM-LOCAL-DIR))
+               (absolute-storm-local-dir conf-relative))))
+      (testing
+        "for absolute path"
+        (is (= (if on-windows? "C:\\storm-local" "/var/storm-local")
+               (absolute-storm-local-dir conf-absolute))))
+      (finally (if (not-nil? old-storm-home)
+                 (System/setProperty storm-home-key old-storm-home))))))