Resolution of argument resolution bug Determine pclass of unabiguous (but unspecified) pmethods Consolidate and comment out unused name-with-argvals More bookkeeping

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -222,38 +222,35 @@
         (if name-with-args-include-args? ")"))
       (or max-line-length name-with-args-max-line-length))))

-;; name-with-argvals multi-methods --------------------------------------
-
-(defn name-with-argvals-dispatch [object]
-  (:type object))
-
-(defmulti name-with-argvals
-  "Dispatch based on object type"
-  #'name-with-argvals-dispatch
-  :default :htn-object
-  :hierarchy #'htn-hierarchy)
-
-(defmethod name-with-argvals :htn-object
-  [object]
-  (str (:uid object)))
-
-(defn resolve-arguments [arguments ancestry-path]
+
+
+(defn resolve-arguments [arguments ancestry-path pargs]
   (let [hem (get-htn-object (first ancestry-path))
         {:keys [argument-mappings]} hem
         resolve-arg (fn [arg]
                       (if (variable? arg)
                         (get argument-mappings arg)
                         arg))
+        _ (dbg-println :trace "RA (before)" arguments)
         arguments (map resolve-arg arguments)
+        _ (dbg-println :trace "RA (after)" arguments)
         unresolved (count (filter variable? arguments))
         get-dyn-arg (fn [dyn-arg]
                       (if (map? dyn-arg)
                         (:param dyn-arg)
                         dyn-arg))
         argvals (if (pos? unresolved)
-                  (resolve-arguments arguments (nthrest ancestry-path 2))
+                  (resolve-arguments arguments (nthrest ancestry-path 2) pargs)
                   (mapv get-dyn-arg arguments))]
+    (dbg-println :trace "RA UNRESOLVED" unresolved "ARGVALS" argvals)
     argvals))
+
+;; The younger cousin to resolve-arguments
+(defn resolve-argument [argument argument-mapping]
+  (if (variable? argument)
+    (get argument-mapping argument :unresolved-argument)
+    argument))
+

 ;; returns pclass_ctor_ map
 ;; (defn resolve-plant-class [ir hem-pclass pargs pclass method
@@ -384,33 +381,51 @@
         ]
     pclass-ctor_))

-(defmethod name-with-argvals :htn-task
-  [object]
-  (let [{:keys [name arguments ancestry-path]} object
-        arguments (or arguments [])
-        unresolved (count (filter variable? arguments))
-        argvals (if (pos? unresolved)
-                  (resolve-arguments arguments ancestry-path)
-                  arguments)]
-    (apply str name (conj (vec (conj (interpose ", " argvals) "(")) ")"))))
-
-(defmethod name-with-argvals :htn-method
-  [object]
-  (let [{:keys [name nonprimitive-task]} object
-        method-name (str name)
-        {:keys [name arguments]} nonprimitive-task]
-    (str
-      method-name
-      (str name (or (seq arguments) '())))))
-
-(defmethod name-with-argvals :htn-expanded-method
-  [object]
-  (let [{:keys [expansion-method argument-mappings]} object
-        {:keys [name nonprimitive-task]} expansion-method
-        method-name (str name)
-        {:keys [name arguments]} nonprimitive-task
-        argvals (apply str (interpose " " (map #(get argument-mappings %) arguments)))]
-    (str method-name "(" argvals ")")))
+;; name-with-argvals multi-methods --------------------------------------
+
+;; (defn name-with-argvals-dispatch [object]
+;;   (:type object))
+
+;; (defmulti name-with-argvals
+;;   "Dispatch based on object type"
+;;   #'name-with-argvals-dispatch
+;;   :default :htn-object
+;;   :hierarchy #'htn-hierarchy)
+
+;; (defmethod name-with-argvals :htn-object
+;;   [object]
+;;   (str (:uid object)))
+
+
+;; ;;Commented out since we've change the signature for resolve-arguments
+;; ;; (defmethod name-with-argvals :htn-task
+;; ;;   [object]
+;; ;;   (let [{:keys [name arguments ancestry-path]} object
+;; ;;         arguments (or arguments [])
+;; ;;         unresolved (count (filter variable? arguments))
+;; ;;         argvals (if (pos? unresolved)
+;; ;;                   (resolve-arguments arguments ancestry-path)
+;; ;;                   arguments)]
+;; ;;     (apply str name (conj (vec (conj (interpose ", " argvals) "(")) ")"))))
+
+;; (defmethod name-with-argvals :htn-method
+;;   [object]
+;;   (let [{:keys [name nonprimitive-task]} object
+;;         method-name (str name)
+;;         {:keys [name arguments]} nonprimitive-task]
+;;     (str
+;;       method-name
+;;       (str name (or (seq arguments) '())))))
+
+;; (defmethod name-with-argvals :htn-expanded-method
+;;   [object]
+;;   (let [{:keys [expansion-method argument-mappings]} object
+;;         {:keys [name nonprimitive-task]} expansion-method
+;;         method-name (str name)
+;;         {:keys [name arguments]} nonprimitive-task
+;;         argvals (apply str (interpose " " (map #(get argument-mappings %) arguments)))]
+;;     (str method-name "(" argvals ")")))
+

 ;; print-object multi-methods --------------------------------------

@@ -605,9 +620,10 @@
                (htn-expanded-nonprimitive-task skeleton-task))
         {:keys [temporal-constraints arguments]} task
         new-arguments (if argument-mapping
-                        (mapv #(get argument-mapping %) arguments)
+                        ;;(mapv #(get argument-mapping %) arguments)
+                        (mapv #(resolve-argument % argument-mapping) arguments)
                         arguments)]
-    (dbg-println :debug "  MET TASK" task) ;; DEBUG
+    (dbg-println :debug "  MET TASK" task "NEW-ARGUMENTS" new-arguments) ;; DEBUG
     (update-htn-object!
      (assoc-if task
                :arguments new-arguments
@@ -846,6 +862,8 @@
            flow-characteristics mission-task-weight
            label display-name incidence-set edges irks]
     :as options}]
+  ;;We should never see nil arguments
+  (assert (not (some #(nil? %) arguments)) "htn-primitive-task: Found nil arguments")
   (update-htn-object!
    (assoc-if (htn-task (assoc options :prefix (or prefix "hpt-")))
              :type :htn-primitive-task
@@ -1320,8 +1338,9 @@
             _ (dbg-println :debug "PD ARGS" arguments)
             arguments (or arguments [])
             unresolved (count (filter variable? arguments))
+            _ (dbg-println :trace "PD UNRESOLVED" unresolved "ARGUMENTS" arguments)
             args (if (pos? unresolved)
-                   (resolve-arguments arguments ancestry-path)
+                   (resolve-arguments arguments ancestry-path pargs)
                    arguments)
             _ (dbg-println :debug "PD pclass-ctor_" pclass-ctor_)
             _ (dbg-println :debug "PD get-in" pclass name)
@@ -1661,7 +1680,18 @@
                 ;; we have the wrong plant-class (because the IR always
                 ;; has true or false)
                 (let [plant-class (if (= :plant-fn-symbol type)
-                                    (if (= name 'this) mpclass name)
+                                    (if (= name 'this)
+                                      mpclass
+                                      ;;name might (coincidentally) be a pclass, but probably not
+                                      ;;Let's see if there in one (and only one) method amongst all pclasses
+                                      (let [pclasses-with-method
+                                            (filter #(get-in ir [% :methods method]) (keys ir))]
+                                        (if (= (count pclasses-with-method) 1)
+                                          (first pclasses-with-method)
+                                          ;;If more than one, the method is ambigious!
+                                          (do (dbg-println :warn "GHMS Can't resolve name" name "to a pclass")
+                                              name))))
+                                    ;;else :plant-fn-field
                                     (get-in ir [mpclass :fields field :initial :pclass]))
                       plant-fn-primitive?
                       (get-in ir [plant-class :methods method :primitive])
@@ -1689,7 +1719,8 @@
                       ;;             (or args margs))
                       _ (assert args "ARGS is nil")
                       task-args (or args margs)
-                      _ (dbg-println :debug "TASK-ARGS" task-args)
+                      _ (dbg-println :debug "TASK-ARGS" task-args
+                                     "PLANT-FN-PRIMITIVE?" plant-fn-primitive?)
                       ;;This is the subtask that will be returned (and added to the method)
                       task ((if non-primitive?
                               htn-nonprimitive-task
@@ -1722,8 +1753,9 @@
 (defn make-htn-methods "Construct the HTN Method(s) for mname"
   [ir pargs top-level? mpclass mname display-name margs mbody & [irks]]
   (dbg-println :debug "MHM " "TOP-LEVEL?" top-level? "MPCLASS" mpclass "MNAME" mname
-           "DISPLAY-NAME" display-name
-           "IRKS" irks "MBODY" mbody)
+               "DISPLAY-NAME" display-name
+               "MARGS" margs
+               "IRKS" irks "\nMBODY" mbody)
   (let [irks (conj (or irks [mpclass :methods mname]) :body)
         number-of-subtasks (count mbody)
         first-task-type (:type (get mbody 0))]
@@ -1802,18 +1834,18 @@
             (do
               (log/error "TBD: :else")
               []))]
-      (dbg-println :debug "HTN-METHODS " (with-out-str (pprint methods)))
+      (dbg-println :trace "HTN-METHODS " (with-out-str (pprint methods)))
       methods)))

-;; RETURNS htn data structure in Clojure (optionally converted to JSON in cli.clj)
+;; Creates an htn data structure in Clojure (optionally converted to JSON in cli.clj)
 ;; NOTE: root-task is a string (or nil)!!!
 ;; Examples
 ;;   "(isr-htn.main \"A\" \"B\" \"C\" \"D\")"
 ;;   "(isr-htn.get-data-and-interpret \"A\" \"B\")"
 (defn plan-htn
-  "Weaves a 'plan' from the root task, using the HTN methods.  Minimally hard-coded."
+  "Weaves a 'plan' from the root task, using the HTN methods."
   [ir root-task file-format output]
   (reinitialize-htn-method-table)
   (reinitialize-htn-object-table)


Prefer IRecord for AtomClock print method

This makes it clear that this is a type, instead of it just being a Map
containing a special key.  Personally, I think this looks better.

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -728,7 +728,7 @@
 #?(:clj
    (defmethod print-method AtomicClock
      [& args]
-     (apply (get-method print-method clojure.lang.IPersistentMap) args))
+     (apply (get-method print-method clojure.lang.IRecord) args))
    ;todo  - for cljs
    )


added some some input fields

added some some input fields

--- src/quick_chess/core.cljs
+++ src/quick_chess/core.cljs
@@ -33,7 +33,8 @@
     init-pieces init-colors)})

 (defonce app-state (r/atom init-state))
-(swap! app-state assoc-in [:board 7 4 :color] "#4286f4")
+#_(swap! app-state assoc :height 500)
+#_(swap! app-state assoc-in [:board 7 4 :color] "#4286f4")
 #_(reset! app-state init-state)

 (defn board-style
@@ -61,6 +62,24 @@
                (min (:height data) (:width data))
                0.07)})

+(defn slider-view
+  "adjusts the size of the board"
+  [state]
+  [:input {:type "range" :value (:width state) :min 250 :max 700
+           :style {:width "200px"}
+           :on-change (fn [e]
+                        (let [val (.-target.value e)]
+                          (swap! app-state assoc :width val :height val)))}])
+
+(defn input-view
+  "input of commands through strings"
+  [state value]
+  [:input {:type "text"
+           :value @value
+           :on-change (fn [e]
+                        (let [c (-> e .-target .-value)]
+                          (reset! value c)))}])
+
 (defn board-view
   "the board"
   [state]
@@ -78,8 +97,13 @@
 (defn app-view
   "main component of our app"
   []
-  [:div
-   [board-view @app-state]])
+  (let [value (r/atom "")]
+       (fn []
+         [:div
+          [:div "Size:"]
+          [slider-view @app-state]
+          [board-view @app-state]
+          [input-view @app-state value]])))

 ;; -------------------------
 ;; Initialize app


fix heroku starter

fix heroku starter

--- src/ruuvi_server/core.clj
+++ src/ruuvi_server/core.clj
@@ -48,12 +48,12 @@
   (route/not-found "
not found
")
   )

-(def create-application
-  (-> (handler/site main-routes)
-      ))
+;; TODO create-prod-application and create-dev-application should be callable in a same way
+(def create-prod-application
+  (handler/site main-routes))

 (defn create-dev-application []
-  (-> create-application
+  (-> create-prod-application
       (wrap-reload '(ruuvi-server.core))
       (wrap-stacktrace)))

@@ -63,7 +63,7 @@
   [config]
   (let [port (config :server-port)]
     (info "Server (production) on port" port "starting")
-    (run-jetty (create-application) {:port port :join? false}))
+    (run-jetty create-prod-application {:port port :join? false}))
   )

 (defn start-dev


delete superfluos example

delete superfluos example

--- examples/gyptis-usage/src/gyptis_usage/core.clj
+++ examples/gyptis-usage/src/gyptis_usage/core.clj
@@ -81,8 +81,6 @@
           (title "Most unemployed counties")
           vertical-x-labels))

-(sql/query db [(str "SELECT state_abbrev, gu_name, state_fips, county_fips"
-                    " FROM fips_codes limit 1")])
 (def highest-unemployment-counties-by-name
   (sql/query db
              ["SELECT CONCAT_WS(', ', fips_codes.gu_name, fips_codes.state_abbrev) as x,


produce higher channel indices first

produce higher channel indices first

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9716 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/test.clj
+++ acqEngine/src/org/micromanager/test.clj
@@ -14,6 +14,12 @@
   (when (.tags image)
     (edt (println prefix (.get (.tags image) "Channel")))))

+(defn produce-results [data-processor results]
+  (if (counted? results)
+    (doseq [result results]
+      (.produce data-processor result))
+    (.produce data-processor results)))
+
 (defn simple-data-processor
   "Make a DataProcessor whose process method is implemented by
    process-function, which should accept a single image and return
@@ -22,16 +28,10 @@
   [process-function]
   (proxy [DataProcessor] []
     (process []
-             (let [img (.poll this)]
-               (if (.tags img)
-                 (let [result (process-function img)]
-                   (if (counted? result)
-                     (doseq [image result]
-                       (.produce this image))
-                     (.produce this result)))
-                 (.produce this img))))))
+             (let [img (.poll this)
+                   result (if (.tags img) (process-function img) img)]
+               (produce-results this result)))))

-
 ;A list of image processors that have been attached to
 ;the acquisition engine.
 (defonce image-processors (atom #{}))
@@ -76,7 +76,7 @@
         (let [tags (json-clone (.tags img))]
           (update-tag! tags "ChannelIndex" #(+ 2 %))
           (update-tag! tags "Channel" #(str % "-2"))
-          [img (TaggedImage. (.pix img) tags)]))))
+          [(TaggedImage. (.pix img) tags) img]))))

 (defn restart-test []
   (remove-all-image-processors!)


Uses React onChange over onInput

Uses React onChange over onInput

--- src/wordsmith/editor.cljs
+++ src/wordsmith/editor.cljs
@@ -11,7 +11,7 @@
     (render [_]
       (dom/div nil
         (dom/textarea #js {:id "input-area"
-                           :onInput #(handle-input % input owner)
+                           :onChange #(handle-input % input owner)
                            :value input})
         (dom/div #js {:ref "output-area"
                       :id "output-area"


GAWB-1368: Changing the name of the CANCEL button to DONE

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
@@ -40,7 +40,7 @@
             [:em {} "(file truncated for preview)"])]])
       (when (and (:file @state) (not (:upload-result @state)))
         [:div {:style {:display "inline-flex" }}
-         [comps/Button {:text "Cancel"
+         [comps/Button {:text "Done"
                         :onClick (:cancel props)
                         :style {:marginRight 20}}]
          [comps/Button {:text "Upload"


ei tuu enää poikkeuksia

ei tuu enää poikkeuksia

--- mtg-pairings-wer/src/mtg_pairings/core.clj
+++ mtg-pairings-wer/src/mtg_pairings/core.clj
@@ -11,19 +11,19 @@
 (def server-address  (text ""))

-(defn select-file []
+(defn select-file [event]
   (text! database-location
          (choose-file :success-fn (fn [fc file] (.getAbsolutePath file)))))

 (def database-button (button :text "..."
-                       :listen [:action #(select-file)]))
+                       :listen [:action select-file]))

 (defn upload-results []
   ())

 (def upload-button (button :text "Upload"
-                     :listen [:action #(upload-results)]))
+                     :listen [:action upload-results]))

 (def about-window
   (frame
@@ -31,14 +31,15 @@
     :title "About MTG pairings"
     :size [100 :by 100]
     :content (border-panel
+               :vgap 5
+               :hgap 5
+               :border ""
                :north "This is the WER database sniffer and result uploader"
-               :south (button :text "Close"))))
+               :south (button :text "Close" :listen [:action (fn [event] (-> about-window hide!))]))))

 (defn about-handler [event]
-  (-> (about-window)
-    pack!
-    show!))
+  (-> about-window pack! show!))

 (defn exit-handler [event]
   (System/exit 0))
@@ -72,4 +73,4 @@
  (invoke-later
    (-> (main-window)
      pack!
-     show!)))+     show!)))


no message

no message

--- mtg-pairings-wer/src/mtg_pairings/core.clj
+++ mtg-pairings-wer/src/mtg_pairings/core.clj
@@ -3,43 +3,16 @@
   (:use seesaw.core)
   (:use seesaw.chooser)
   (:use mtg-pairings.watcher)
+  (:use mtg-pairings.uploader)
   (:require [cheshire.core :refer :all])
   (:import (java.io File FileNotFoundException)))

 (native!)

-
-(def database-location (text :editable? false :text "%AppData%\\Wizards of the Coast\\Event Reporter\\TournamentData.dat"))
-
-(def server-address  (text :editable? false :text "http://mtgsuomi.fi/pairings/api"))
-
-(def address-checkbox (checkbox :text "Edit address" :selected? false
-                        :listen [:action (fn [event] (config! server-address :editable? (config address-checkbox :selected?)))]))
-
-
-(defn select-file [event]
-  (if @watcher (stop!))
-  (text! database-location
-         (choose-file :success-fn (fn [fc file] (.getAbsolutePath file))
-                    :cancel-fn (fn [fc] (text database-location) )))
-  (if (.exists (File. (text database-location)))
-   (start! (text database-location) )
-   (-> (dialog :content "Error opening file") pack! show!)))
-
-
-(def database-button (button :text "..."
-                       :listen [:action select-file]))
-
-(defn upload-results []
-  ())
-
-(def upload-button (button :text "Upload"
-                     :listen [:action upload-results]))
-
 (def tournament-label (text :text "" :editable? false))

 (def tournament-listbox (listbox :model "none" :selection-mode :multi-interval))
-
+
 (def tournament-selector
   (frame
     :on-close :dispose
@@ -60,10 +33,73 @@
           (-> tournament-selector pack! show! ))
     (-> (dialog :content "No database opened") pack! show!)))

+(def pairings-checkbox (checkbox :text "Pairings" :selected? false))
+
+(def results-checkbox (checkbox :text "Results" :selected? false))
+
+(def seatings-checkbox (checkbox :text "Seatings" :selected? false))
+
+(def api-key (text ""))
+
+(def database-location (text :editable? false :text "%AppData%\\Wizards of the Coast\\Event Reporter\\TournamentData.dat"))
+
+(def server-address  (text :editable? false :text "http://mtgsuomi.fi/pairings"))
+
+(def address-checkbox (checkbox :text "Edit address" :selected? false
+                        :listen [:action (fn [event] (config! server-address :editable? (config address-checkbox :selected?)))]))
+
+(defn tournament-handler [id]
+  (-> (dialog :content "New tournament has been added to database!") pack! show!))
+
+(defn standings-handler [id]
+  (-> (dialog :content "New standings have been added to database!") pack! show!))
+
+(defn pairings-handler [id]
+  (-> (dialog :content "New pairings have been added to database!") pack! show!))
+
+(defn results-handler [id]
+  (-> (dialog :content "New results have been added to database!") pack! show!))
+
+(defn seatings-handler [id]
+  (-> (dialog :content "New seatings have been added to database!") pack! show!))
+
+
+
+(defn select-file [event]
+  (if @watcher (stop!))
+  (text! database-location
+         (choose-file :success-fn (fn [fc file] (.getAbsolutePath file))
+                    :cancel-fn (fn [fc] (text database-location) )))
+  (if (.exists (File. (text database-location)))
+   (start! (text database-location) :tournament tournament-handler :standings standings-handler
+                 :pairings pairings-handler :results results-handler :seatings seatings-handler )
+   (-> (dialog :content "Error opening file") pack! show!)))
+
+
+(def database-button (button :text "..."
+                       :listen [:action select-file]))
+
+(defn upload-results [parametri]
+  (let [url (text server-address) key (text api-key) sanction-id
+        (:sanction-id (get-tournament (second (selection tournament-listbox))))
+        tournament-id (get-tournament (second (selection tournament-listbox)))]
+    (upload-tournament! url key (get-tournament tournament-id))
+    (upload-teams! url sanction-id key (get-teams tournament-id))
+    (if (config seatings-checkbox :selected?)
+      (upload-seatings! url sanction-id key (get-seatings tournament-id)))
+    (if (config pairings-checkbox :selected?)
+      (upload-pairings! url sanction-id (get-pairings-count tournament-id)
+                        key (get-pairings tournament-id (get-pairings-count tournament-id))))
+    (if (config results-checkbox :selected?)
+      (upload-results! url sanction-id (get-results-count tournament-id)
+                       key (get-results tournament-id (get-results-count (tournament-id)))))))
+
+(def upload-button (button :text "Upload"
+                     :listen [:action upload-results]))
+
+
 (def tournament-button (button :text "Select"
                          :listen [:action select-tournament]))
-
-(def api-key (text ""))

 (def about-window
   (frame
@@ -89,11 +125,6 @@

 (def exit-action (menu-item :text "Exit" :listen [:action exit-handler]))

-(def pairings-checkbox (checkbox :text "New pairings" :selected? false))
-
-(def results-checkbox (checkbox :text "Standings" :selected? false))
-
-

 (def main-window
   (frame
@@ -113,7 +144,8 @@
                        "Tournament:" tournament-label tournament-button
                        "" "" ""
                        "Upload results:" upload-button pairings-checkbox
-                       "" "" results-checkbox])
+                       "" "" results-checkbox
+                       "" "" seatings-checkbox])
                ))

@@ -121,5 +153,6 @@
  (-> main-window pack! show!)
  (if @watcher (stop!))
  (if (.exists (File. (text database-location)))
-   (start! (text database-location) )
+   (start! (text database-location) :tournament tournament-handler :standings standings-handler
+                 :pairings pairings-handler :results results-handler :seatings seatings-handler )
    (-> (dialog :content "Database not found at default location, please set database location.") pack! show!)))


Strip out type identifier

Strip out type identifier

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/interface.clj
+++ src/obcc/build/interface.clj
@@ -73,7 +73,7 @@
 ;;-----------------------------------------------------------------
 (defn buildfields [ast]
   (let [rawfields (getfields ast)]
-    (map (fn [[index {:keys [modifier type fieldName]}]] (->Field modifier type fieldName index)) rawfields)))
+    (map (fn [[index {:keys [modifier type fieldName]}]] (->Field modifier (let [[_ _type] type] _type) fieldName index)) rawfields)))

 (defn buildmessage [ast]
   (let [name (->> ast zip/right zip/node)


Fix filter syntax.

Fix filter syntax.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -29,9 +29,9 @@
             (r/get-all query index-values {:index index-name})
             ;; Filter on the allowed-boards
             (if (sequential? allowed-boards)
-              (r/fn [post-row]
+              (r/filter query (r/fn [post-row]
                 ;; All records in boards the user has no access
-                (r/contains allowed-boards (r/get-field post-row :board-uuid)))
+                (r/contains allowed-boards (r/get-field post-row :board-uuid))))
               query)
             ;; Merge in a last-activity-at date for each post, which is the
             ;; last comment created-at, with fallback to published-at or created-at for published entries


Bad type hint.

Bad type hint.

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -196,7 +196,7 @@
         (let [t (System/currentTimeMillis)
               snapshot @publications
               to-remove (map first
-                             (filter (fn [[k v]] (>= (- ^long t ^long @(:last-used v)) idle))
+                             (filter (fn [[k v]] (>= (- t ^long @(:last-used v)) idle))
                                      snapshot))]
           (doseq [k to-remove]
             (let [pub (:publication (snapshot k))


include logo if already set in company map

--- src/open_company/lib/bot.clj
+++ src/open_company/lib/bot.clj
@@ -23,7 +23,7 @@
 (defmulti adapt (fn [type _] type))

 (defmethod adapt :company [_ m]
-  (select-keys m [:name :slug :description :currency]))
+  (select-keys m [:name :logo :slug :description :currency]))

 (defmethod adapt :user [_ m]
   {:name (first (string/split (:real-name m) #"\ "))})


whitespace formatting

whitespace formatting

--- src/overtone/studio/inst.clj
+++ src/overtone/studio/inst.clj
@@ -62,17 +62,17 @@
 (defmethod inst-fx! :mono
   [inst fx]
   (let [fx-group (:fx-group inst)
-        bus (:bus inst)
-        fx-id (fx :tgt fx-group :pos :tail :bus bus)]
+        bus      (:bus inst)
+        fx-id    (fx :tgt fx-group :pos :tail :bus bus)]
     fx-id))

 (defmethod inst-fx! :stereo
   [inst fx]
   (let [fx-group (:fx-group inst)
-        bus-l (to-sc-id (:bus inst))
-        bus-r (inc bus-l)
-        fx-ids [(fx :tgt fx-group :pos :tail :bus bus-l)
-                (fx :tgt fx-group :pos :tail :bus bus-r)]]
+        bus-l    (to-sc-id (:bus inst))
+        bus-r    (inc bus-l)
+        fx-ids   [(fx :tgt fx-group :pos :tail :bus bus-l)
+                  (fx :tgt fx-group :pos :tail :bus bus-r)]]
     fx-ids))

 (defn clear-fx
@@ -84,23 +84,23 @@
   [& args]
   (let [[sname params param-proxies ugen-form] (normalize-synth-args args)]
     `(let [~@param-proxies]
-       (binding [*ugens* []
+       (binding [*ugens*     []
                  *constants* #{}]
          (with-overloaded-ugens
-           (let [form# ~@ugen-form
+           (let [form#               ~@ugen-form
                  ;; form# can be a map, or a sequence of maps. We use
                  ;; `sequence?` because `coll?` applies to maps (which
                  ;; are not sequential) and `seq?` does not apply to
                  ;; vectors (which are sequential).
-                 n-chans# (if (sequential? form#) (count form#) 1)
-                 inst-bus# (or (:bus (get (:instruments @studio*) ~sname))
-                               (audio-bus n-chans#))
+                 n-chans#            (if (sequential? form#) (count form#) 1)
+                 inst-bus#           (or (:bus (get (:instruments @studio*) ~sname))
+                                         (audio-bus n-chans#))
                  [ugens# constants#] (gather-ugens-and-constants (out inst-bus# form#))
-                 ugens# (topological-sort-ugens ugens#)
-                 main-tree# (set ugens#)
-                 side-tree# (filter #(not (main-tree# %)) *ugens*)
-                 ugens# (concat ugens# side-tree#)
-                 constants# (into [] (set (concat constants# *constants*)))]
+                 ugens#              (topological-sort-ugens ugens#)
+                 main-tree#          (set ugens#)
+                 side-tree#          (filter #(not (main-tree# %)) *ugens*)
+                 ugens#              (concat ugens# side-tree#)
+                 constants#          (into [] (set (concat constants# *constants*)))]
              [~sname
               ~params
               ugens#
@@ -248,7 +248,7 @@
   {:arglists '([name doc-string? params ugen-form])}
   [i-name & inst-form]
   (let [[i-name params ugen-form] (synth-form i-name inst-form)
-        i-name (with-meta i-name (merge (meta i-name) {:type ::instrument}))]
+        i-name                    (with-meta i-name (merge (meta i-name) {:type ::instrument}))]
     `(def ~i-name (inst ~i-name ~params ~ugen-form))))

 (defmethod print-method ::instrument [ins w]


Ring stuff: Rename handlers and wrapped handlers

--- test/com/nomistech/clojure_the_language/c_800_libraries/s_800_web/ss_020_ring.clj
+++ test/com/nomistech/clojure_the_language/c_800_libraries/s_800_web/ss_020_ring.clj
@@ -23,20 +23,21 @@
 ;;;; ___________________________________________________________________________
 ;;;; ---- wrap-json-response ----

-(defn handler-001 [request]
+(defn handler-with-interesting-response [request]
   (rur/response {:foo "bar"}))

-(def app-001
-  (rmj/wrap-json-response handler-001))
+(def wrapped-handler-with-interesting-response
+  (-> handler-with-interesting-response
+      rmj/wrap-json-response))

 (fact "Handler with response whose body is Clojure data"
-  (handler-001 {})
+  (handler-with-interesting-response {})
   => {:status 200
       :headers {}
       :body {:foo "bar"}})

 (fact "Wrapped handler with response whose body is JSON"
-  (app-001 {})
+  (wrapped-handler-with-interesting-response {})
   => {:status 200
       :headers {"Content-Type" "application/json; charset=utf-8"}
       :body "{\"foo\":\"bar\"}"})
@@ -44,23 +45,25 @@
 ;;;; ___________________________________________________________________________
 ;;;; ---- wrap-json-body ----

-(defn handler-002 [request]
+(defn handler-with-interesting-request [request]
   (let [user (get-in request [:body :user] "<no user specified>")]
     (rur/response (str "Uploaded '" user "'."))))

-(def app-002
-  (rmj/wrap-json-body handler-002 {:keywords? true
-                                   :bigdecimals? true}))
+(def wrapped-handler-with-interesting-request
+  (-> handler-with-interesting-request
+      (rmj/wrap-json-body {:keywords? true
+                           :bigdecimals? true})))

 (fact "Handler with request whose body is Clojure data"
-  (handler-002 {:body {:user "Fred"}})
+  (handler-with-interesting-request {:body {:user "Fred"}})
   => {:status 200
       :headers {}
       :body "Uploaded 'Fred'."})

 (fact "Wrapped handler with request whose body is JSON"
-  (app-002 {:headers {"content-type" "application/json; charset=utf-8"}
-            :body (string->stream "{\"user\":\"Fred\"}")})
+  (wrapped-handler-with-interesting-request
+   {:headers {"content-type" "application/json; charset=utf-8"}
+    :body (string->stream "{\"user\":\"Fred\"}")})
   => {:status 200
       :headers {}
       :body "Uploaded 'Fred'."})


Remove root-dir and subdir-to-save configuration from domain

--- main/src/dda/pallet/dda_backup_crate/domain.clj
+++ main/src/dda/pallet/dda_backup_crate/domain.clj
@@ -46,13 +46,8 @@
    (s/optional-key :db-post-processing) [s/Str]})

 (def BackupPath
-  ;TODO: either does not work here ...
-  ;(s/either
     {:backup-path [directory-model/NonRootDirectory]
      (s/optional-key :new-owner) s/Str})
-    ;{:root-dir directory-model/NonRootDirectory
-    ; :subdir-to-save [directory-model/NonRootDirectory]
-    ; (s/optional-key :new-owner) s/Str})

 (def BackupElement
   "The backup elements"
@@ -126,23 +121,14 @@
         {})
       {:dda-backup backup-user})))

-; TODO: move to downstream namespace as that should not be exposed to outside.
-(defn
-  create-backup-path
-  [backup-element]
-  (if (contains? (:backup-path backup-element) :root-dir)
-    (update backup-element :backup-path [(map #(str (-> backup-element :backup-path :root-dir) %) (-> backup-element :backup-path :subdir-to-save))])
-    backup-element))
-
 (s/defn ^:always-validate
   infra-backup-element :- infra-schema/BackupElement
   [backup-element :- BackupElementResolved]
   (let [{:keys [name type]} backup-element]
-    (merge
-      (create-backup-path backup-element)
-      {:backup-file-name           (element-type/backup-file-name name type)
-       :backup-file-prefix-pattern (element-type/backup-file-prefix-pattern name type)
-       :type-name                  (element-type/element-type-name type)})))
+    (-> backup-element
+        (assoc :backup-file-name (element-type/backup-file-name name type))
+        (update :backup-file-prefix-pattern (element-type/backup-file-prefix-pattern name type))
+        (update :type-name  (element-type/element-type-name type)))))

 (s/defn ^:always-validate
   infra-config :- infra-schema/ResolvedBackupConfig


Cleanup

Cleanup

--- demo/reagentdemo/core.cljs
+++ demo/reagentdemo/core.cljs
@@ -20,29 +20,21 @@
           :alt "Fork me on GitHub"
           :src "https://s3.amazonaws.com/github/ribbons/forkme_left_orange_ff7600.png"}]])

-;; (def index-page "index.html")
-;; (def news-page "news/index.html")
+(def index-page "/index.html")
+(def title "Minimalistic React for ClojureScript")

-;; (tools/register-page index-page [#'intro/main]
-;;                      "Reagent: Minimalistic React for ClojureScript")
-;; (tools/register-page news-page [#'news/main]
-;;                      "Reagent news")
-
-(def title "Minimalistic React for ClojureScript")
+(tools/register-page index-page [#'intro/main] title)

 (defroute "/" []
   (dispatch [:set-content [#'intro/main] title]))
-(defroute main-page "/index.html" []
-  (dispatch [:set-content [#'intro/main] title]))
-(tools/reg-page (main-page))

 (defn demo []
   [:div
    [:div.nav
     [:ul.nav
-     [:li.brand [link {:href (main-page)} "Reagent:"]]
-     [:li [link {:href (main-page)} "Intro"]]
+     [:li.brand [link {:href index-page} "Reagent:"]]
+     [:li [link {:href index-page} "Intro"]]
      [:li [link {:href news/url} "News"]]
      [:li [:a github "GitHub"]]]]
    @test-results


Fix dotfiles script

Fix dotfiles script

--- link.clj
+++ link.clj
@@ -16,7 +16,8 @@
       (clojure.java.io/delete-file path))))

 (defn- remove-and-link [file]
-  (let [linking-file (io/file user-home file) linked-file (io/file dotfiles-dir file)]
+  (let [linking-file (io/file user-home (str "." file))
+        linked-file (io/file dotfiles-dir file)]
     (remove-existed linking-file)
     (Files/createSymbolicLink
      (.toPath linking-file)


correctly add mentions to client-side store

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -97,8 +97,8 @@
   (maybe-create-thread! (message :thread-id))
   (transact! [:threads (message :thread-id) :messages] #(conj % message))

-  (transact! [:threads (message :thread-id) :tags] #(conj % (message :mentioned-tag-ids)))
-  (transact! [:threads (message :thread-id) :mentioned-ids] #(conj % (message :mentioned-user-ids))))
+  (transact! [:threads (message :thread-id) :tags] #(apply conj % (message :mentioned-tag-ids)))
+  (transact! [:threads (message :thread-id) :mentioned-ids] #(apply conj % (message :mentioned-user-ids))))

 (defn add-open-thread! [thread]
   ; TODO move notifications logic out of here


use consistent db for searching

use consistent db for searching

--- src/chat/server/search.clj
+++ src/chat/server/search.clj
@@ -63,7 +63,7 @@
                                   [(fulltext $ :message/content ?txt) [[?m]]]
                                   [?m :message/thread ?t]
                                   [?t :thread/id ?t-id]]
-                                (d/db db/*conn*) text)))]
+                                search-db text)))]
     (->> (if (every? some? [text-search tag-search])
            (intersection text-search tag-search)
            (first (remove nil? [text-search tag-search])))


Modified the tests to use fixtures.

Modified the tests to use fixtures.

--- test/blutwurst/database_test.clj
+++ test/blutwurst/database_test.clj
@@ -4,6 +4,13 @@
     (:import (java.sql DriverManager)))

 (def connection-string "jdbc:h2:mem:test")
+
+(defn clear-database [connection-string]
+  (let [connection (DriverManager/getConnection connection-string)
+        statement (.createStatement connection)]
+    (.execute statement "drop all objects")
+    (.close statement)
+  ))

 (defn create-test-tables [connection-string]
   (let [connection (DriverManager/getConnection connection-string)
@@ -14,13 +21,18 @@
     (.close statement)
   ))

+(defn db-fixture [f]
+  (create-test-tables connection-string)
+  (f)
+  (clear-database connection-string))
+
+(use-fixtures :each db-fixture)
+
 (deftest table-graph-tests
   (testing "Connects to an in-memory database and returns basic table list."
-   (let [spec {:connection-string connection-string}]
-       (create-test-tables connection-string)
-     (let [table-graph (retrieve-table-graph spec)]
+     (let [spec {:connection-string connection-string}
+           table-graph (retrieve-table-graph spec)]
        (println table-graph)
        (is (= {:tables '({:name "PERSON" :schema "DBO" :columns ({:name "NAME"} {:name "ID"})})}
-              table-graph))
-       ))
+              table-graph)))
    ))


use localized shutdown flag in test

use localized shutdown flag in test

--- test/bract/core/inducer_test.clj
+++ test/bract/core/inducer_test.clj
@@ -210,8 +210,10 @@

 (deftest test-add-shutdown-hook
-  (let [hooks (atom [])
-        context {:bract.core/shutdown-hooks hooks
+  (let [flag  (atom false)
+        hooks (atom [])
+        context {:bract.core/shutdown-flag  flag
+                 :bract.core/shutdown-hooks hooks
                  :bract.core/config {"bract.core.drain.timeout" [1 :seconds]}}]
     (testing "default invocation"
       (try
@@ -221,6 +223,7 @@
           (.join))
         (.removeShutdownHook ^Runtime (Runtime/getRuntime) (last @hooks))
         (finally
+          (reset! flag false)
           (swap! hooks pop))))
     (testing "inducer invocation"
       (try
@@ -230,6 +233,7 @@
           (.join))
         (.removeShutdownHook ^Runtime (Runtime/getRuntime) (last @hooks))
         (finally
+          (reset! flag false)
           (swap! hooks pop))))))


moar tests!

moar tests!

--- test/circle/backend/test_ec2.clj
+++ test/circle/backend/test_ec2.clj
@@ -1,6 +1,7 @@
 (ns circle.backend.test-ec2
   (:use circle.backend.ec2)
   (:require [circle.backend.load-balancer :as lb])
+  (:use [circle.util.except :only (throwf)])
   (:use midje.sweet))

 (fact "safe terminate doesn't terminate instances attached to the load balancer"
@@ -16,3 +17,8 @@
   (provided
     (lb/instances "www") => ["i-production"]))

+(future-fact "block-until-running retries when instance returns nil"
+  (block-until-running "i-bogus") => (throws Exception)
+  (provided
+    (instance anything) =streams=> [(throwf "not started") (throwf "not started") (throwf "not started") :running]))
+


better names

better names


Catch and log all unhandled exceptions at service entry point.

--- src/clinvar_submitter/web_service.clj
+++ src/clinvar_submitter/web_service.clj
@@ -27,22 +27,27 @@
 ;; ]
 ;;
 (defn submitter-v1-handler [request]
-  (let [req (slurp (:body request))
-        options (:options request)
-        records (variant/process-input req options)
-        variants (into [] (map (fn [record] {:submission record
-                                             :errors (report/get-webservice-exception-data-for-row record options)}) records))
-        success_count (count (filter empty? (map #(:errors %) variants)))
-        body {:status {:totalRecords (count records)
-                       :successCount success_count
-                       :errorCount (- (count records) success_count)}
-              :variants variants}
-        resp (json/generate-string body)]
-    (log/info "clinvar-subitter service info:\nRequest: " req " \nResponse: " resp)
-    {:status 200
-     :headers {"Content-Type" "application/json"}
-     :body resp}))
-
+  (try
+    (let [req (slurp (:body request))
+          options (:options request)
+          records (variant/process-input req options)
+          variants (into [] (map (fn [record] {:submission record
+                                               :errors (report/get-webservice-exception-data-for-row record options)}) records))
+          success_count (count (filter empty? (map #(:errors %) variants)))
+          body {:status {:totalRecords (count records)
+                         :successCount success_count
+                         :errorCount (- (count records) success_count)}
+                :variants variants}
+          resp (json/generate-string body)]
+      (if (some? req)
+        (log/debug "\nRequest: " req " \nResponse: " resp)
+        (log/debug "Request contained no 'body' element content."))
+      {:status 200
+       :headers {"Content-Type" "application/json"}
+       :body resp})
+    (catch Exception ex
+      (log/error "\nCaught Exception: " (.getMessage ex) "\nStackTrace: "(.printStackTrace ex)))))
+
 ;; Routing handler
 (defn route-handler [request]
   ;; this is admittedly rudimentary routing


Don't enable hide button when result pane is big enough.

--- src/cljs/editor/quil_site/editor.cljs
+++ src/cljs/editor/quil_site/editor.cljs
@@ -16,12 +16,17 @@

 (defn show-result-pane []
   (let [view-width (.-offsetWidth (.querySelector js/document "#content"))
-        pane-width (first @result-pane-size)]
+        pane-width (first @result-pane-size)
+        pane-bigger? (> pane-width (j/outer-width (j/$ "iframe")))]
     (j/css (j/$ "#result-content") "left" (str (- view-width
                                                   pane-width
                                                   scroll-width)
-                                               "px")))
-  (j/remove-class (j/$ "#hide") "disabled"))
+                                               "px"))
+    ; when pane bigger - it means that it won't slide because
+    ; it already enough space to cover the whole iframe.
+    ; in that case don't enable "hide" button
+    (when-not pane-bigger?
+      (j/remove-class (j/$ "#hide") "disabled"))))

 (defn set-errors [errors]
   (let [options (.-options (.getOption @editor "lint"))]


Forgot to commit utilities

Forgot to commit utilities

--- src/cljs/gtfve/utils/google_maps.cljs
+++ src/cljs/gtfve/utils/google_maps.cljs
@@ -52,6 +52,17 @@
   (-js->clj [this options] {:sw (js->clj (.getSouthWest this))
                             :ne (js->clj (.getNorthEast this))}))

+(defn info-window []
+  (Maps.InfoWindow.))
+
+(defn size [x y]
+  (Maps.Size. 0 -30))
+
+(defn latlng [x y]
+  (Maps.LatLng. x y))
+
+(defn data-point [x y]
+  (Data.Point. (latlng x y)))

 (defn data-listen
   ([data type]


Fix the tests so that they run (if not pass)

--- test/dependable/resolve_test.clj
+++ test/dependable/resolve_test.clj
@@ -17,38 +17,38 @@

 (let  [package-a30
        (->package
-         "a"
-         30
-         "a_loc30"
-         [
-          [(present "c")]
-          ])
+        "a"
+        30
+        "a_loc30"
+        [
+         [(present "c")]
+         ])
        package-a20
        (->package
-         "a"
-         20
-         "a_loc20"
-         nil)
+        "a"
+        20
+        "a_loc20"
+        nil)
        package-c10
        (->package
-         "c"
-         10
-         "c_loc10"
-         nil)
+        "c"
+        10
+        "c_loc10"
+        nil)
        package-d22
        (->package
         "d"
         22
         "d_loc22"
-         nil)
+        nil)
        package-e18
        (->package
-         "e"
-         18
-         "e_loc18"
-         [
-          [(present "d")]
-          ])
+        "e"
+        18
+        "e_loc18"
+        [
+         [(present "d")]
+         ])
        repo-info
        {"a"
         [package-a30
@@ -59,427 +59,439 @@
         [package-d22]}
        query (map-query repo-info)]
   (deftest ^:resolve-basic ^:resolve-first-tier retrieval
-           (testing "Asking for a present package succeeds."
-                    (is (= (resolve-dependencies
-                             [
-                              [(present "d")]
-                              ]
-                             query)
-                           [:successful #{package-d22}]))
-           (is (= (resolve-dependencies
-                    [
-                     [(present "c")]
-                     ]
-                    query)
-                  [:successful #{package-c10}])))
-           (testing "Asking for a nonexistent package fails."
-                    (let [b-clause [(present "b")]]
-                      (is (= (resolve-dependencies
-                               [b-clause]
-                               query)
-                             [:unsuccessful b-clause]))))
-           (testing (str "Asking for a package present within the repo but "
-                         "at no suitable version fails.")
-                    (let [a-clause
-                          [(present
-                             "a"
-                             #(>= (:version %1) 40))]]
-                      (is (= (resolve-dependencies
-                               [a-clause]
-                               query)
-                             [:unsuccessful a-clause]))))
-           (testing (str "Asking for a package present within the repo but "
-                         "with unsuccessful constraints.")
-                    (let [a-clause
-                          [(present
-                             "a"
-                             (fn [v] false))]]
-                      (is (= (resolve-dependencies
-                               [a-clause]
-                               query)
-                             [:unsuccessful a-clause]))))
-           (testing (str "Asking for a package present and having a "
-                         "version that fits")
-                    (is (= (resolve-dependencies
-                             [[(present "a" #(and (>= (:version %1) 15)
-                                                  (<= (:version %1) 25)))]]
-                             query)
-                           [:successful #{package-a20}]))
-                    (is (= (resolve-dependencies
-                             [[(present "d" #(>= (:version %1) 20))]]
-                             query)
-                           [:successful #{package-d22}]))))
-(deftest present-packages
-         (testing "Asking to install a package twice."
-                  (is (= (resolve-dependencies
-                           [{:id "a"}
-                            {:id "a"}]
-                           query)
-                         [:successful #{package-a30}])))
-         (testing (str "Asking to install a package that I have given as "
-                       "already installed.")
-                  (is (= (resolve-dependencies [{:id "c"}]
-                                               query
-                                               :present-packages {"c" 18})
-                         [:successful #{}])))
-         (testing (str "Asking to install a package that I have given as already "
-                       "installed, even though the package isn't available.")
-                  (is (= (resolve-dependencies
-                           [{:id "b"}]
-                           query
-                           :present-packages {"b" 30})
-                         [:successful #{}])))
-         (testing (str "Asking to install a package that is already "
-                       "installed, but the installed version doesn't "
-                       "suit, even though there is a suitable version "
-                       "available.")
-                  (is (= (resolve-dependencies
-                           [{:id "a"
-                             :version-spec #(>= % 25)}]
-                           query
-                           :present-packages {"a" 15})
-                         [:unsuccessful ["a"]])))
-         (testing (str "Asking to install a package that is already "
-                       "installed, and the installed version suits.")
-                  (is (= (resolve-dependencies
-                           [{:id "a"
-                             :version-spec #(>= % 25)}]
-                           query
-                           :present-packages {"a" 30})
-                         [:successful #{}]))))
-(deftest conflicts
-         (testing (str "Find a package which conflicts with another "
-                       "package also to be installed.")
-                  (is (= (resolve-dependencies
-                           [{:id "d"}
-                            {:id "e"}]
-                           query)
-                         [:unsuccessful ["e"]])))
-         (testing (str "Find a package which conflicts with a package "
-                       "marked a priori as conflicting.")
-                  (is (= (resolve-dependencies
-                           [{:id "a"}
-                            {:id "d"}]
-                           query
-                           :conflicts {"d" nil})
-                         [:unsuccessful ["d"]])))
-         (testing (str "Find a package which conflicts with a package "
-                       "marked a priori as conflicting with something "
-                       "already installed.")
-                  (is (= (resolve-dependencies
-                           [{:id "d"}]
-                           query
-                           :present-packages {"a" 11}
-                           :conflicts {"d" nil})
-                         [:unsuccessful ["d"]])))
-
-         (testing (str "Find a package which conflicts with another "
-                       "package but not at its current version")
-                  (is (= (resolve-dependencies
-                           [{:id "d"}]
-                           query
-                           :conflicts {"d" #(< % 22)})
-                         [:successful #{package-d22}])))))
+    (testing "Asking for a present package succeeds."
+      (is (= (resolve-dependencies
+              [
+               [(present "d")]
+               ]
+              query)
+             [:successful #{package-d22}]))
+      (is (= (resolve-dependencies
+              [
+               [(present "c")]
+               ]
+              query)
+             [:successful #{package-c10}])))
+    (testing "Asking for a nonexistent package fails."
+      (let [b-clause [(present "b")]]
+        (is (= (resolve-dependencies
+                [b-clause]
+                query)
+               [:unsuccessful b-clause]))))
+    (testing (str "Asking for a package present within the repo but "
+                  "at no suitable version fails.")
+      (let [a-clause
+            [(present
+              "a"
+              #(>= (:version %1) 40))]]
+        (is (= (resolve-dependencies
+                [a-clause]
+                query)
+               [:unsuccessful a-clause]))))
+    (testing (str "Asking for a package present within the repo but "
+                  "with unsuccessful constraints.")
+      (let [a-clause
+            [(present
+              "a"
+              (fn [v] false))]]
+        (is (= (resolve-dependencies
+                [a-clause]
+                query)
+               [:unsuccessful a-clause]))))
+    (testing (str "Asking for a package present and having a "
+                  "version that fits")
+      (is (= (resolve-dependencies
+              [[(present "a" #(and (>= (:version %1) 15)
+                                   (<= (:version %1) 25)))]]
+              query)
+             [:successful #{package-a20}]))
+      (is (= (resolve-dependencies
+              [[(present "d" #(>= (:version %1) 20))]]
+              query)
+             [:successful #{package-d22}]))))
+  (deftest ^:resolve-basic present-packages
+    (testing "Asking to install a package twice."
+      (is (= (resolve-dependencies
+              [
+               [(present "c")]
+               [(present "c")]
+               ]
+              query)
+             [:successful #{package-c10}])))
+    (testing (str "Asking to install a package that I have given as "
+                  "already installed.")
+      (is (= (resolve-dependencies
+              [
+               [(present "c")]
+               ]
+              query
+              :present-packages
+              {"c" package-c10})
+             [:successful #{}])))
+    (testing (str "Asking to install a package that I have given as already "
+                  "installed, even though the package isn't available.")
+      (is (= (resolve-dependencies
+              [
+               [(present "c")]
+               ]
+              query
+              :present-packages {"b"
+                                 (->package "b" 10 "b-loc10" nil)})
+             [:successful #{}])))
+    (testing (str "Asking to install a package that is already "
+                  "installed, but the installed version doesn't "
+                  "suit, even though there is a suitable version "
+                  "available.")
+      (let [clause [(present "a" #(>= (:version %) 25))]]
+        (is (= (resolve-dependencies
+                [
+                 clause
+                 ]
+                query
+                :present-packages {"a" package-a20})
+               [:unsuccessful clause]))))
+    (testing (str "Asking to install a package that is already "
+                  "installed, and the installed version suits.")
+      (is (= (resolve-dependencies
+              [
+               [(present "a" #(>= (:version %) 25))]
+               ]
+              query
+              :present-packages {"a" package-a30})
+             [:successful #{}]))))
+  (deftest conflicts
+    (testing (str "Find a package which conflicts with another "
+                  "package also to be installed.")
+      (is (= (resolve-dependencies
+              [{:id "d"}
+               {:id "e"}]
+              query)
+             [:unsuccessful ["e"]])))
+    (testing (str "Find a package which conflicts with a package "
+                  "marked a priori as conflicting.")
+      (is (= (resolve-dependencies
+              [{:id "a"}
+               {:id "d"}]
+              query
+              :conflicts {"d" nil})
+             [:unsuccessful ["d"]])))
+    (testing (str "Find a package which conflicts with a package "
+                  "marked a priori as conflicting with something "
+                  "already installed.")
+      (is (= (resolve-dependencies
+              [{:id "d"}]
+              query
+              :present-packages {"a" 11}
+              :conflicts {"d" nil})
+             [:unsuccessful ["d"]])))
+
+    (testing (str "Find a package which conflicts with another "
+                  "package but not at its current version")
+      (is (= (resolve-dependencies
+              [{:id "d"}]
+              query
+              :conflicts {"d" #(< % 22)})
+             [:successful #{package-d22}])))))

 #_(deftest ^:resolve-basic requires
-           (let [package-a
-                 {:id "a"
-                  :version 30
-                  :location "a_loc30"
-                  :requires [{:id "b"}]}
-                 package-b
-                 {:id "b"
-                  :version 20
-                  :location "b_loc20"}
-                 repo-info
-                 {"a" [package-a]
-                  "b" [package-b]}
-                 query (map-query repo-info)]
-             (testing (str "One package should require another and both "
-                           "should be found.")
-                      (is (= (resolve-dependencies
-                               [{:id "a"}]
-                               query)
-                             [:successful #{package-a package-b}])))
-             (testing (str "One package should be found when it requires "
-                           "another, but it's already installed.")
-                      (is (= (resolve-dependencies
-                               [{:id "a"}]
-                               query
-                               :present-packages {"b" 20})
-                             [:successful #{package-a}]))))
-           (let [package-a
-                 {:id "a"
-                  :version 10
-                  :location "a_loc30"}
-                 package-b
-                 {:id "b"
-                  :version 20
-                  :location "b_loc20"
-                  :requires [{:id "c"}]}
-                 package-c
-                 {:id "c"
-                  :version 10
-                  :conflicts {"a" nil}}
-
-                 repo-info
-                 {"a" [package-a]
-                  "b" [package-b]
-                  "c" [package-c]}
-                 query (map-query repo-info)]
-             (testing (str "A package having dependencies which conflicts with "
-                           "other packages downloaded should be rejected.")
-                      (is (= (resolve-dependencies
-                               [{:id "a"}
-                                {:id "b"}]
-                               query)
-                             [:unsuccessful ["b" "c"]]))))
-           (let [package-a
-                 {:id "a"
-                  :version 10
-                  :location "a_loc10"}
-                 package-b
-                 {:id "b"
-                  :version 10
-                  :location "b_loc10"
-                  :requires [{:id "c"}]}
-                 package-c
-                 {:id "c"
-                  :version 10
-                  :local "c_loc10"}
-                 repo-info
-                 {"a" [package-a]
-                  "b" [package-b]
-                  "c" [package-c]}
-                 query (map-query repo-info)]
-             (testing (str "A package having dependencies rejected a priori "
-                           "also gets rejected")
-                      (is (= (resolve-dependencies
-                               [{:id "a"}
-                                {:id "b"}]
-                               query
-                               :conflicts {"c" nil})
-                             [:unsuccessful ["b" "c"]])))))
+    (let [package-a
+          {:id "a"
+           :version 30
+           :location "a_loc30"
+           :requires [{:id "b"}]}
+          package-b
+          {:id "b"
+           :version 20
+           :location "b_loc20"}
+          repo-info
+          {"a" [package-a]
+           "b" [package-b]}
+          query (map-query repo-info)]
+      (testing (str "One package should require another and both "
+                    "should be found.")
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query)
+               [:successful #{package-a package-b}])))
+      (testing (str "One package should be found when it requires "
+                    "another, but it's already installed.")
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query
+                :present-packages {"b" 20})
+               [:successful #{package-a}]))))
+    (let [package-a
+          {:id "a"
+           :version 10
+           :location "a_loc30"}
+          package-b
+          {:id "b"
+           :version 20
+           :location "b_loc20"
+           :requires [{:id "c"}]}
+          package-c
+          {:id "c"
+           :version 10
+           :conflicts {"a" nil}}
+
+          repo-info
+          {"a" [package-a]
+           "b" [package-b]
+           "c" [package-c]}
+          query (map-query repo-info)]
+      (testing (str "A package having dependencies which conflicts with "
+                    "other packages downloaded should be rejected.")
+        (is (= (resolve-dependencies
+                [{:id "a"}
+                 {:id "b"}]
+                query)
+               [:unsuccessful ["b" "c"]]))))
+    (let [package-a
+          {:id "a"
+           :version 10
+           :location "a_loc10"}
+          package-b
+          {:id "b"
+           :version 10
+           :location "b_loc10"
+           :requires [{:id "c"}]}
+          package-c
+          {:id "c"
+           :version 10
+           :local "c_loc10"}
+          repo-info
+          {"a" [package-a]
+           "b" [package-b]
+           "c" [package-c]}
+          query (map-query repo-info)]
+      (testing (str "A package having dependencies rejected a priori "
+                    "also gets rejected")
+        (is (= (resolve-dependencies
+                [{:id "a"}
+                 {:id "b"}]
+                query
+                :conflicts {"c" nil})
+               [:unsuccessful ["b" "c"]])))))

 #_(deftest ^:resolve-basic no-locking
-           (testing (str "Find two packages, even when the preferred version "
-                         "of one package conflicts with the other")
-                    (let [package-a30
-                          {:id "a"
-                           :version 30
-                           :location "a_loc30"
-                           :conflicts {"c" nil}
-                           }
-                          package-a20
-                          {:id "a"
-                           :version 20
-                           :location "a_loc20"}
-                          package-c10
-                          {:id "c"
-                           :version 10
-                           :location "c_loc10"}
-                          repo-info
-                          {"a" [package-a30 package-a20]
-                           "c" [package-c10]}
-                          query (map-query repo-info)]
-                      (is (= (resolve-dependencies
-                               [{:id "a"}
-                                {:id "c"}]
-                               query)
-                             [:successful #{package-a20 package-c10}]))))
-           (testing (str "Diamond problem")
-                    (let [package-a
-                          {:id "a"
-                           :version 1
-                           :location "a_loc1"
-                           :requires [{:id "b"}
-                                      {:id "c"}]}
-                          package-b
-                          {:id "b"
-                           :version 1
-                           :location "b_loc1"
-                           :requires [{:id "d"
-                                       :version-spec #(>= % 2)}]}
-                          package-c
-                          {:id "c"
-                           :version 1
-                           :location "c_loc1"
-                           :requires [{:id "d"
-                                       :version-spec #(< % 4)}]}
-                          package-d3
-                          {:id "d"
-                           :version 3
-                           :location "d_loc3"}
-                          package-d4
-                          {:id "d"
-                           :version 4
-                           :location "d_loc4"}
-                          repo-info
-                          {"a" [package-a]
-                           "b" [package-b]
-                           "c" [package-c]
-                           "d" [package-d4 package-d3]}
-                          query
-                          (map-query repo-info)]
-                      (is (= (resolve-dependencies
-                               [{:id "a"}]
-                               query)
-                             [:successful
-                              #{package-a
-                                package-b
-                                package-c
-                                package-d3}]))))
-           (testing (str "Inter-Locking Diamond problem")
-                    (let [package-a
-                          {:id "a"
-                           :version 1
-                           :location "a_loc1"
-                           :requires [{:id "b"}
-                                      {:id "c"}]}
-                          package-b
-                          {:id "b"
-                           :version 1
-                           :location "b_loc1"
-                           :requires [{:id "d"
-                                       :version-spec #(>= % 2)}
-                                      {:id "e"
-                                       :version-spec #(= % 5)}]}
-                          package-c
-                          {:id "c"
-                           :version 1
-                           :location "c_loc1"
-                           :requires [{:id "e"
-                                       :version-spec #(>= % 1)}
-                                      {:id "d"
-                                       :version-spec #(< % 4)}]}
-                          package-d3
-                          {:id "d"
-                           :version 3
-                           :location "d_loc3"}
-                          package-d4
-                          {:id "d"
-                           :version 4
-                           :location "d_loc4"}
-                          package-e6
-                          {:id "e"
-                           :version 6
-                           :location "e_loc6"}
-                          package-e5
-                          {:id "e"
-                           :version 6
-                           :location "e_loc5"}
-                          repo-info
-                          {"a" [package-a]
-                           "b" [package-b]
-                           "c" [package-c]
-                           "d" [package-d4 package-d3]
-                           "e" [package-e6 package-e5]}
-                          query
-                          (map-query repo-info)]
-                      (is (= (resolve-dependencies
-                               [{:id "a"}]
-                               query)
-                             [:successful
-                              #{package-a
-                                package-b
-                                package-c
-                                package-d3
-                                package-e5}]))))
-(testing (str "The puzzle")
-         (let [package-a
-               {:id "a"
-                :version 1
-                :location "a_loc1"
-                :requires [{:id "b"}
-                           {:id "c"}]}
-               package-b
-               {:id "b"
-                :version 1
-                :location "b_loc1"
-                :requires [{:id "d"
-                            :version-spec #(>= % 1)}]}
-               package-c
-               {:id "c"
-                :version 1
-                :location "c_loc1"
-                :requires [{:id "d"
-                            :version-spec #(< % 4)}]}
-               package-d1
-               {:id "d"
-                :version 1
-                :location "d_loc1"
-                :requires [{:id "e"
-                            :version-spec #(= % 4)}]}
-               package-d2
-               {:id "d"
-                :version 2
-                :location "d_loc2"
-                :requires [{:id "e"
-                            :version-spec #(= % 3)}]}
-               package-e4
-               {:id "e"
-                :version 4
-                :location "e_loc4"}
-               package-e3
-               {:id "e"
-                :version 3
-                :location "e_loc3"}
-               repo-info
-               {"a" [package-a]
-                "b" [package-b]
-                "c" [package-c]
-                "d" [package-d2 package-d1]
-                "e" [package-e4 package-e3]}
-               query
-               (map-query repo-info)]
-           (is (= (resolve-dependencies
-                    [{:id "a"}]
-                    query)
-                  [:successful #{package-a
-                                 package-b
-                                 package-c
-                                 package-d1
-                                 package-e4}]))))
-(testing (str "Double diamond")
-         (let [package-a
-               {:id "a"
-                :version 1
-                :location "a_loc1"
-                :requires [{:id "b"}
-                           {:id "d"
-                            :version-spec #(>= % 1)}]}
-               package-b
-               {:id "b"
-                :version 1
-                :location "b_loc1"
-                :requires [{:id "d"
-                            :version-spec #(< % 4)}]}
-               package-c
-               {:id "c"
-                :version 1
-                :location "c_loc1"
-                :requires [{:id "d"
-                            :version-spec #(= % 2)}]}
-               package-d4
-               {:id "d"
-                :version 4
-                :location "d_loc4"}
-               package-d3
-               {:id "d"
-                :version 3
-                :location "d_loc3"}
-               package-d2
-               {:id "d"
-                :version 2
-                :location "d_loc2"}
-               repo-info
-               {"a" [package-a]
-                "b" [package-b]
-                "c" [package-c]
-                "d" [package-d4 package-d3 package-d2]}
-               query (map-query repo-info)]
-           (is (= (resolve-dependencies
-                    [{:id "a"}]
-                    query)
-                  [:successful #{package-d2 package-c package-b package-a}])))))
+    (testing (str "Find two packages, even when the preferred version "
+                  "of one package conflicts with the other")
+      (let [package-a30
+            {:id "a"
+             :version 30
+             :location "a_loc30"
+             :conflicts {"c" nil}
+             }
+            package-a20
+            {:id "a"
+             :version 20
+             :location "a_loc20"}
+            package-c10
+            {:id "c"
+             :version 10
+             :location "c_loc10"}
+            repo-info
+            {"a" [package-a30 package-a20]
+             "c" [package-c10]}
+            query (map-query repo-info)]
+        (is (= (resolve-dependencies
+                [{:id "a"}
+                 {:id "c"}]
+                query)
+               [:successful #{package-a20 package-c10}]))))
+    (testing (str "Diamond problem")
+      (let [package-a
+            {:id "a"
+             :version 1
+             :location "a_loc1"
+             :requires [{:id "b"}
+                        {:id "c"}]}
+            package-b
+            {:id "b"
+             :version 1
+             :location "b_loc1"
+             :requires [{:id "d"
+                         :version-spec #(>= % 2)}]}
+            package-c
+            {:id "c"
+             :version 1
+             :location "c_loc1"
+             :requires [{:id "d"
+                         :version-spec #(< % 4)}]}
+            package-d3
+            {:id "d"
+             :version 3
+             :location "d_loc3"}
+            package-d4
+            {:id "d"
+             :version 4
+             :location "d_loc4"}
+            repo-info
+            {"a" [package-a]
+             "b" [package-b]
+             "c" [package-c]
+             "d" [package-d4 package-d3]}
+            query
+            (map-query repo-info)]
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query)
+               [:successful
+                #{package-a
+                  package-b
+                  package-c
+                  package-d3}]))))
+    (testing (str "Inter-Locking Diamond problem")
+      (let [package-a
+            {:id "a"
+             :version 1
+             :location "a_loc1"
+             :requires [{:id "b"}
+                        {:id "c"}]}
+            package-b
+            {:id "b"
+             :version 1
+             :location "b_loc1"
+             :requires [{:id "d"
+                         :version-spec #(>= % 2)}
+                        {:id "e"
+                         :version-spec #(= % 5)}]}
+            package-c
+            {:id "c"
+             :version 1
+             :location "c_loc1"
+             :requires [{:id "e"
+                         :version-spec #(>= % 1)}
+                        {:id "d"
+                         :version-spec #(< % 4)}]}
+            package-d3
+            {:id "d"
+             :version 3
+             :location "d_loc3"}
+            package-d4
+            {:id "d"
+             :version 4
+             :location "d_loc4"}
+            package-e6
+            {:id "e"
+             :version 6
+             :location "e_loc6"}
+            package-e5
+            {:id "e"
+             :version 6
+             :location "e_loc5"}
+            repo-info
+            {"a" [package-a]
+             "b" [package-b]
+             "c" [package-c]
+             "d" [package-d4 package-d3]
+             "e" [package-e6 package-e5]}
+            query
+            (map-query repo-info)]
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query)
+               [:successful
+                #{package-a
+                  package-b
+                  package-c
+                  package-d3
+                  package-e5}]))))
+    (testing (str "The puzzle")
+      (let [package-a
+            {:id "a"
+             :version 1
+             :location "a_loc1"
+             :requires [{:id "b"}
+                        {:id "c"}]}
+            package-b
+            {:id "b"
+             :version 1
+             :location "b_loc1"
+             :requires [{:id "d"
+                         :version-spec #(>= % 1)}]}
+            package-c
+            {:id "c"
+             :version 1
+             :location "c_loc1"
+             :requires [{:id "d"
+                         :version-spec #(< % 4)}]}
+            package-d1
+            {:id "d"
+             :version 1
+             :location "d_loc1"
+             :requires [{:id "e"
+                         :version-spec #(= % 4)}]}
+            package-d2
+            {:id "d"
+             :version 2
+             :location "d_loc2"
+             :requires [{:id "e"
+                         :version-spec #(= % 3)}]}
+            package-e4
+            {:id "e"
+             :version 4
+             :location "e_loc4"}
+            package-e3
+            {:id "e"
+             :version 3
+             :location "e_loc3"}
+            repo-info
+            {"a" [package-a]
+             "b" [package-b]
+             "c" [package-c]
+             "d" [package-d2 package-d1]
+             "e" [package-e4 package-e3]}
+            query
+            (map-query repo-info)]
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query)
+               [:successful #{package-a
+                              package-b
+                              package-c
+                              package-d1
+                              package-e4}]))))
+    (testing (str "Double diamond")
+      (let [package-a
+            {:id "a"
+             :version 1
+             :location "a_loc1"
+             :requires [{:id "b"}
+                        {:id "d"
+                         :version-spec #(>= % 1)}]}
+            package-b
+            {:id "b"
+             :version 1
+             :location "b_loc1"
+             :requires [{:id "d"
+                         :version-spec #(< % 4)}]}
+            package-c
+            {:id "c"
+             :version 1
+             :location "c_loc1"
+             :requires [{:id "d"
+                         :version-spec #(= % 2)}]}
+            package-d4
+            {:id "d"
+             :version 4
+             :location "d_loc4"}
+            package-d3
+            {:id "d"
+             :version 3
+             :location "d_loc3"}
+            package-d2
+            {:id "d"
+             :version 2
+             :location "d_loc2"}
+            repo-info
+            {"a" [package-a]
+             "b" [package-b]
+             "c" [package-c]
+             "d" [package-d4 package-d3 package-d2]}
+            query (map-query repo-info)]
+        (is (= (resolve-dependencies
+                [{:id "a"}]
+                query)
+               [:successful #{package-d2 package-c package-b package-a}])))))


style

style

--- modules/reitit-ring/src/reitit/ring.cljc
+++ modules/reitit-ring/src/reitit/ring.cljc
@@ -95,8 +95,8 @@
   ([data]
    (router data nil))
   ([data opts]
-   (let [opts (merge {:coerce                    coerce-handler
-                      :compile                   compile-result
+   (let [opts (merge {:coerce coerce-handler
+                      :compile compile-result
                       ::default-options-endpoint default-options-endpoint}
                      opts)]
      (r/router data opts))))


Add missing require.

Add missing require.

--- src/kixi/hecuba/api/entities/upload.clj
+++ src/kixi/hecuba/api/entities/upload.clj
@@ -4,6 +4,7 @@
    [clojure.core.match          :refer (match)]
    [clojure.tools.logging       :as log]
    [kixipipe.pipeline           :as pipe]
+   [kixipipe.storage.s3]
    [kixi.hecuba.security        :refer (has-admin? has-programme-manager? has-project-manager? has-user?) :as sec]
    [kixi.hecuba.webutil         :as util]
    [kixi.hecuba.webutil         :refer (decode-body authorized? stringify-values sha1-regex update-stringified-lists content-type-from-context uuid)]


CLJ-2391 Reorder spec problem printing

CLJ-2391 Reorder spec problem printing

Signed-off-by: Alex Miller <99328387f8334f68433c424d2dfd83062f62754b@cognitect.com>

--- src/main/clojure/clojure/spec/alpha.clj
+++ src/main/clojure/clojure/spec/alpha.clj
@@ -231,18 +231,15 @@
     (let [problems (sort-by #(- (count (:path %))) (::problems ed))]
       ;;(prn {:ed ed})
       (doseq [{:keys [path pred val reason via in] :as prob} problems]
+        (pr val)
+        (print " - failed: ")
+        (if reason (print reason) (pr (abbrev pred)))
         (when-not (empty? in)
-          (print "In:" (pr-str in) ""))
-        (print "val: ")
-        (pr val)
-        (print " fails")
+          (print (str " in: " (pr-str in))))
+        (when-not (empty? path)
+          (print (str " at: " (pr-str path))))
         (when-not (empty? via)
-          (print " spec:" (pr-str (last via))))
-        (when-not (empty? path)
-          (print " at:" (pr-str path)))
-        (print " predicate: ")
-        (pr (abbrev pred))
-        (when reason (print ", " reason))
+          (print (str " spec: " (pr-str (last via)))))
         (doseq [[k v] prob]
           (when-not (#{:path :pred :val :reason :via :in} k)
             (print "\n\t" (pr-str k) " ")


slurp the script with it abspath

slurp the script with it abspath

--- src/clj/runbld/process.clj
+++ src/clj/runbld/process.clj
@@ -170,7 +170,7 @@
     (merge
      res
      {:cmd cmd
-      :cmd-source (slurp scriptfile)
+      :cmd-source (slurp scriptfile*)
       :bytes (:bytes res)})))

 (s/defn start-file-listener! :- [ManyToManyChannel]


Adding TODOs

Adding TODOs

--- src/cljs/zetawar/subs.cljs
+++ src/cljs/zetawar/subs.cljs
@@ -11,7 +11,8 @@
    [zetawar.util :refer [breakpoint inspect select-values]])
   (:require-macros
    [zetawar.subs :refer [deftrack]]))
-;; TODO: add asserts to check params for better error messages?
+
+;; TODO: add param asserts to check params for better error messages?

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; App
@@ -56,6 +57,7 @@
               '[:map/description]
               @(game-map-eid conn)))

+;; TODO: use terrains output instead of running a separate query
 (deftrack terrain-eid-at [conn q r]
   (let [game-eid' @(game-eid conn)
         idx (game/game-pos-idx game-eid' q r)]


map-partition-to-pair

map-partition-to-pair

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -207,6 +207,13 @@
   [rdd f]
   (.mapPartitions rdd (flat-map-function f)))

+(defn map-partitions-to-pair
+  "Similar to `map`, but runs separately on each partition (block) of the `rdd`, so function `f`
+  must be of type Iterator<T> => Iterable<U>.
+  https://issues.apache.org/jira/browse/SPARK-3369"
+  [rdd f & {:keys [preserves-partitioning]}]
+  (.mapPartitionsToPair rdd (pair-flat-map-function f) (u/truthy? preserves-partitioning)))
+
 (defn map-partition-with-index
   "Similar to `map-partition` but function `f` is of type (Int, Iterator<T>) => Iterator<U> where
   `i` represents the index of partition."


Cleaned up the evolution functions and added a useable entry point.

--- src/clojure_robby/core.clj
+++ src/clojure_robby/core.clj
@@ -3,17 +3,20 @@

 (use 'clojure-robby.util)

+
+(def map-count 20) ; The amount of maps to evaluate each individual on.
+(def individual-count 30); The amount of individuals to operate on.
+
 (def map-size 20) ; Size of the map used for robot simulation.
-(def evolution-map-count 20) ; The amount of maps to evaluate each individual on.
 (def gold-prob 20) ; Probability in 100 that a tile contains gold.
 (def simul-steps 100) ; Steps to allow the robot to make in a simulation.
 (def tiles [\w \p \g]) ; Tiles that populate the map: wall, path, and gold.
-(def actions [\u \d \l \r \x \p]) ; Actions the robot can take: up, down, left, right, pick up.
+(def actions [\u \d \l \r \p \x]) ; Actions the robot can take: up, down, left, right, pick up, move random.

 (def multipliers (map (fn [n] (** (count tiles) n)) (range 5))) ; Used to calculate genes to use.
-(def dir-vects ['(0 -1) '(0 1) '(-1 0) '(1 0) '(0 0)]) ; Direction vectors, corresponding to the 4 actions.
+(def dir-vects ['(0 -1) '(0 1) '(-1 0) '(1 0) '(0 0)]) ; Direction vectors, corresponding to the 5 actions.

-(def mutation-prob 5) ; Probability in 100 that a gene will mutate.
+(def mutation-prob 4) ; Probability in 100 that a gene will mutate.
 (def action-penalty 5) ; How many points robot loses when hitting the wall or picking up when it shouldn't.
 (def gold-value 10) ; How many points picking up gold is worth.

@@ -103,20 +106,32 @@

 ; Evolution functions
-(defn evolve [individuals]
-  "Takes a bunch of individuals (DNAs), throws away the weak, and cross-breeds."
-  (let [the-maps (repeatedly evolution-map-count rand-map)
-        eval-map-fn (fn [a-map]
+(defn select [individuals]
+  "Takes a bunch of individuals (DNAs) and returns the better half of the population, sorted from worst."
+  (let [the-maps (repeatedly map-count rand-map)
+        eval-map (fn [a-map]
                       (mapv (fn [a-dna] (simulate a-dna a-map)) individuals))
-        evaluated (reduce (partial mapv +) (pmap eval-map-fn the-maps))
-        to-drop (/ (count individuals) 2)
-        good (drop to-drop (sort-by (fn [dna] (nth evaluated (.indexOf individuals dna))) individuals))
-        breed-fn (fn [dna]
-                   (cross dna (rand-nth good)))]
-    (println (simulate (last good) (first the-maps)))
-    (mapv mutate (concat (mapv breed-fn good) (mapv breed-fn good)))))
+        fitnesses (reduce (partial mapv +) (pmap eval-map the-maps))
+        sorted (sort-by #(nth fitnesses (.indexOf individuals %)) individuals)]
+    (println (float (/ (reduce + fitnesses) (* individual-count map-count))))
+    (drop (/ (count individuals) 2) sorted)))

-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))
+(defn breed [individuals]
+  "Takes a bunch of individuals (DNAs) and returns twice as many after breeding."
+  (let [breed-one (fn [dna]
+                   (cross dna (rand-nth individuals)))
+        breed-all (fn []
+                    (mapv breed-one individuals))]
+    (mapv mutate (concat (breed-all) (breed-all)))))
+
+(defn nth-best [n]
+  "Returns the best individual after n generations."
+  (let [population (repeatedly individual-count rand-dna)
+        iteration (iterate #(breed (select %)) population)]
+    (last (nth iteration n))))
+
+
+; Entry point
+(defn -main [num & args]
+  (nth-best num))
+


TCLJS-26: exclude uuid?

TCLJS-26: exclude uuid?

--- src/cognitect/transit.cljs
+++ src/cognitect/transit.cljs
@@ -13,7 +13,7 @@
 ;; limitations under the License.

 (ns cognitect.transit
-  (:refer-clojure :exclude [integer? uuid])
+  (:refer-clojure :exclude [integer? uuid uuid?])
   (:require [com.cognitect.transit :as t]
             [com.cognitect.transit.types :as ty]
             [com.cognitect.transit.eq :as eq])


Added default character encoding of UTF-8

--- src/compojure/response.clj
+++ src/compojure/response.clj
@@ -17,7 +17,7 @@
   String
   (render [body _]
     (-> (response body)
-        (content-type "text/html")))
+        (content-type "text/html; charset=utf-8")))
   APersistentMap
   (render [resp-map _]
     (merge (response "") resp-map))


Removed "om" from display names.

Removed "om" from display names.

--- src/sablono/interpreter.cljx
+++ src/sablono/interpreter.cljx
@@ -36,14 +36,9 @@
                    :onChange (aget this "onChange")
                    :children (aget (.-props this) "children")}))))}))

-#+cljs
-(def input (wrap-form-element js/React.DOM.input "OmInput"))
-
-#+cljs
-(def textarea (wrap-form-element js/React.DOM.textarea "OmTextarea"))
-
-#+cljs
-(def option (wrap-form-element js/React.DOM.option "OmOption"))
+#+cljs (def input (wrap-form-element js/React.DOM.input "Input"))
+#+cljs (def option (wrap-form-element js/React.DOM.option "Option"))
+#+cljs (def textarea (wrap-form-element js/React.DOM.textarea "Textarea"))

 #+cljs
 (defn dom-fn [tag]


Add some docstrings

Add some docstrings

--- src/scramblyzer/analyzer.clj
+++ src/scramblyzer/analyzer.clj
@@ -57,13 +57,14 @@

 (defn- ignore-piece-unless
   [pred piece]
-  "Unless the piece or any of its twists matches the predicate,
-  replace it with the Acube symbol for ignore (@?)"
+  "Unless the piece satisfies the predicate, replace it with the Acube
+  symbol for ignore (@?)"
   (if (pred piece)
     piece
     "@?"))

 (defn- filter-pieces
+  "Ignore any pieces not matching the predicate."
   ([pred state]
    (filter-pieces pred pred state))
   ([edge-pred corner-pred state]
@@ -75,6 +76,7 @@

 (defn cross-dist
   [scramble]
+  "How many moves are required the solve the cross on D of the scramble."
   (let [state (scramble->state scramble)]
     (solve-optimal
       (filter-pieces


[WM] fix git command in lein new output

[WM] fix git command in lein new output

-a after `git add .` is redundant (and potentially not what you want if you do anything to the working directory between the 2 commands).

--- src/leiningen/new/kraken_http_api.clj
+++ src/leiningen/new/kraken_http_api.clj
@@ -17,7 +17,7 @@
     (main/info " * `chmod +x script/*`")
     (main/info " * `git init`")
     (main/info " * `git add .`")
-    (main/info " * `git commit -am \"initial commit\"`")
+    (main/info " * `git commit -m \"initial commit\"`")
     (main/info " * push this to github")
     (main/info " * make a Buildkite project")
     (->files data


bumped up clj version

bumped up clj version

--- src/leiningen/new/reagent/project.clj
+++ src/leiningen/new/reagent/project.clj
@@ -6,7 +6,7 @@

   :source-paths ["src/clj" "src/cljs"{{{cljx-source-paths}}}]

-  :dependencies [[org.clojure/clojure "1.7.0-RC1"]
+  :dependencies [[org.clojure/clojure "1.7.0-RC2"]
                  [ring-server "0.4.0"]
                  [cljsjs/react "0.13.3-0"]
                  [reagent "0.5.0"]


Minor changes. FPS now white

Minor changes. FPS now white

--- src/divergence/entity.cljs
+++ src/divergence/entity.cljs
@@ -3,6 +3,7 @@
             [divergence.system :as s]))

 (def normal-gravity 0.2)
+
 (def playerTexture (js/PIXI.Texture.fromImage "assets/img/player.png"))
 (def blockTexture (js/PIXI.Texture.fromImage "assets/img/Brick_Block.png"))
 (def boxTexture (js/PIXI.Texture.fromImage "assets/img/box.png"))
@@ -10,6 +11,7 @@
 (def bgTexture (js/PIXI.Texture.fromImage "assets/img/background.png"))
 (def ropeTexture (js/PIXI.Texture.fromImage "assets/img/rope.png"))
 (def keyTexture (js/PIXI.Texture.fromImage "assets/img/key.png"))
+

 (defn entity [components]
   (reduce


Fix notification token setting so it doesn't overwrite previous values.

--- src/forces_assemble/db.clj
+++ src/forces_assemble/db.clj
@@ -64,7 +64,7 @@
   (mc/update mongodb
              coll-users
              {:_id user-id}
-             {:notification-token token}
+             {$set {:notification-token token}}
              {:upsert true}))

 (defn get-subscribed-channels


Delete extra close-paren

Delete extra close-paren

--- src/foreclojure/graphs.clj
+++ src/foreclojure/graphs.clj
@@ -46,7 +46,7 @@
     (when-not (> (count freqs) 1)
       (chart/add-text chart best (freqs best 0)
                       "Very little golfing data - chart may suck"))
-    (doto chart (chart/set-theme :bw)))))
+    (doto chart (chart/set-theme :bw))))

 (defn serve-plot [plot]
   (let [out (ByteArrayOutputStream.)


added placeholder image and cleaned up album artwork

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -88,13 +88,16 @@
           (let [picture-data (first
                                (.-picture
                                  (.-tags
-                                   (core/get-music-info-from-id (:current-track-id data)))))
-                picture-format (.-format picture-data)
-                picture-buffer (.-data picture-data)
-                base64-data (js/base64ArrayBuffer picture-buffer)
-                data-uri (str "data:" "image/jpeg" ";base64," base64-data)]
-            (om/set-state! owner {:cover-image data-uri
-                                  :track-id (:current-track-id data)})))))
+                                   (core/get-music-info-from-id (:current-track-id data)))))]
+            (if (nil? picture-data)
+              (om/set-state! owner{:cover-image nil
+                                   :track-id (:current-track-id data)})
+              (let [picture-format (.-format picture-data)
+                    picture-buffer (.-data picture-data)
+                    base64-data (js/base64ArrayBuffer picture-buffer)
+                    data-uri (str "data:" "image/jpeg" ";base64," base64-data)]
+                (om/set-state! owner {:cover-image data-uri
+                                      :track-id (:current-track-id data)})))))))
     om/IRenderState
     (render-state [this state]
       (if-not (nil? (:current-track-id data))
@@ -105,9 +108,13 @@
             (dom/div #js {:style #js {:float "left"
                                       :width "10%"
                                       :height "10%"}}
-              (dom/img #js {:src (:cover-image state)
-                            :style #js {:width "100%"
-                                        :height "100%"}}))
+              (if (nil? (:cover-image state))
+                (dom/img #js {:src grey-out-image
+                              :style #js {:width "100%"
+                                          :height "100%"}})
+                (dom/img #js {:src (:cover-image state)
+                              :style #js {:width "100%"
+                                          :height "100%"}})))
             (dom/div nil
               (dom/div nil (.-title tags))
               (dom/div nil (.-album tags))


log level

log level


:bug: Properly send 403 on not authorized request.

--- backend/src/uxbox/http/session.clj
+++ backend/src/uxbox/http/session.clj
@@ -56,7 +56,7 @@
                                (spx/terminate (assoc data ::unauthorized true)))))
                   (vc/handle-on-context))))
    :leave (fn [data]
-            (if (and (::unauthorized data) (:response data))
+            (if (::unauthorized data)
               (update data :response
                       assoc :status 403 :body {:type :authentication
                                                :code :unauthorized})


OO: Only render submission-view when there is data available This ensures will-unmount gets called when there is no data

--- src/hatti/views/table.cljs
+++ src/hatti/views/table.cljs
@@ -346,31 +346,13 @@
    in the SlickGrid documentation for event handlers.
    https://github.com/mleibman/SlickGrid/wiki/Getting-Started"
   (reify
-    om/IRenderState
-    (render-state [_ _]
-      (let [no-data? (empty? (get-in app-state [:data]))
-            {:keys [num_of_submissions] :as dataset-info}
-            (:dataset-info app-state)
-            with-info #(merge % {:dataset-info dataset-info})]
-        (html
-         [:div.table-view
-          (om/build submission-view
-                    (with-info (get-in app-state
-                                       [:table-page :submission-clicked]))
-                    {:opts (merge (select-keys opts #{:delete-record! :role})
-                                  {:view :table})})
-          (om/build table-header app-state)
-          [:div {:id table-id :class "slickgrid"}
-           (if (and no-data? (zero? num_of_submissions))
-             [:span {:class "empty-state"} "No data"]
-             [:span
-              [:i.fa.fa-spinner.fa-pulse] "Loading..."])]])))
     om/IDidMount
     (did-mount [_]
       (let [data (get-in app-state [:data])]
         (when-let [[grid dataview]
                    (init-grid! data owner slick-grid-event-handlers)]
           (handle-table-events app-state grid dataview))))
+
     om/IWillReceiveProps
     (will-receive-props [_ next-props]
       "will-recieve-props resets slickgrid data if the table data has changed."
@@ -385,4 +367,30 @@
             (do ; data has changed
               (.invalidateAllRows grid)
               (.setItems dataview (clj->js new-data) _id)
-              (.render grid))))))))
+              (.render grid))))))
+
+    om/IRender
+    (render [_]
+      (let [{:keys [data dataset-info]
+             {:keys [prevent-scrolling-in-table-view? submission-clicked]}
+             :table-page}
+            app-state
+            {:keys [num_of_submissions]} dataset-info
+            no-data? (empty? data)
+            with-info #(merge % {:dataset-info dataset-info})]
+        (html
+         [:div {:class "table-view"
+                :style (when prevent-scrolling-in-table-view?
+                         {:height (get-table-view-height)
+                          :overflow "hidden"})}
+          (when (:data submission-clicked)
+            (om/build submission-view
+                      (with-info submission-clicked)
+                      {:opts (merge (select-keys opts #{:delete-record! :role})
+                                    {:view :table})}))
+          (om/build table-header app-state)
+          [:div {:id table-id :class "slickgrid"}
+           (if (and no-data? (zero? num_of_submissions))
+             [:span {:class "empty-state"} "No data"]
+             [:span
+              [:i.fa.fa-spinner.fa-pulse] "Loading..."])]])))))


Add tests for resolve operation.

Add tests for resolve operation.


Add tests for ranged open.

Add tests for ranged open.

--- test/blocks/core_test.clj
+++ test/blocks/core_test.clj
@@ -16,18 +16,30 @@
 ;; ## IO Tests

 (deftest block-input-stream
+  (testing "ranged open validation"
+    (let [block (block/read! "abcdefg")]
+      (is (thrown? IllegalArgumentException (block/open block nil 4)))
+      (is (thrown? IllegalArgumentException (block/open block -1 4)))
+      (is (thrown? IllegalArgumentException (block/open block 0 nil)))
+      (is (thrown? IllegalArgumentException (block/open block 0 -1)))
+      (is (thrown? IllegalArgumentException (block/open block 3 1)))
+      (is (thrown? IllegalArgumentException (block/open block 0 10)))))
   (testing "empty block"
     (let [block (empty (block/read! "abc"))]
-      (is (thrown? IOException (block/open block)))))
+      (is (thrown? IOException (block/open block))
+          "full open should throw exception")
+      (is (thrown? IOException (block/open block 0 3))
+          "ranged open should throw exception")))
   (testing "literal block"
-    (let [block (block/read! "the old dog jumped")
-          stream (block/open block)]
-      (is (instance? InputStream stream))
-      (is (= "the old dog jumped" (slurp stream)))))
+    (let [block (block/read! "the old dog jumped")]
+      (is (= "the old dog jumped" (slurp (block/open block))))
+      (is (= "old dog" (slurp (block/open block 4 11))))))
   (testing "lazy block"
-    (let [block (block/from-file "README.md")]
+    (let [block (block/from-file "README.md")
+          readme (slurp (block/open block))]
       (is (not (realized? block)) "file blocks should be lazy")
-      (is (string? (slurp (block/open block)))))))
+      (is (string? readme))
+      (is (= (subs readme 10 20) (slurp (block/open block 10 20)))))))

 (deftest block-reading


locale broke rss date check

locale broke rss date check

--- test/bløggr/rss_test.clj
+++ test/bløggr/rss_test.clj
@@ -25,7 +25,7 @@
   (let [rss (get-rss settings posts)]
     rss => (contains "<title>\nPost A title\n</title>")
     rss => (contains "<description>\nPost A content\n</description>")
-    rss => (contains "<pubDate>\nSun, 02 Jan 2000 04:04:05 +0100\n</pubDate>")
+    rss => (contains "<pubDate>")
     rss => (contains "<link>\nhttp://url.com/2000/01/02/post_a_title/\n</link>")))

 (fact "get-rss should change relative image paths to absolute paths"


remove leftover debug tap

remove leftover debug tap

--- src/main/shadow/build/cljs_hacks.cljc
+++ src/main/shadow/build/cljs_hacks.cljc
@@ -970,8 +970,6 @@

       :variadic-invoke
       (let [mfa (:max-fixed-arity expr)]
-        (when (= 'cljs.spec.test-test (get-in expr [:env :ns :name]))
-          (?> expr :variadic-invoke))
         (comp/emits f ".cljs$core$IFn$_invoke$arity$variadic(" (comma-sep (take mfa args))
           (when-not (zero? mfa) ",")
           "cljs.core.prim_seq.cljs$core$IFn$_invoke$arity$2(["


Force link more classes

Force link more classes

--- minicraft-online/ios/project.clj
+++ minicraft-online/ios/project.clj
@@ -11,7 +11,7 @@
   :source-paths ["src/clojure" "../desktop/src-common"]
   :java-source-paths ["src/java"]
   :javac-options ["-target" "1.7" "-source" "1.7" "-Xlint:-options"]
-  :ios {:robovm-opts ["-forcelinkclasses" "minicraft_online.**:clojure.**:com.badlogic.**:play_clj.**"
+  :ios {:robovm-opts ["-forcelinkclasses" "minicraft_online.**:clojure.**:com.badlogic.**:play_clj.**:schema.**:potemkin**:potemkin.**"
                       "-libs" "libs/libObjectAL.a:libs/libgdx.a:libs/libgdx-box2d.a:libs/libgdx-bullet.a"
                       "-frameworks" "UIKit:OpenGLES:QuartzCore:CoreGraphics:OpenAL:AudioToolbox:AVFoundation"
                       "-resources" "../desktop/resources/**"]}