Work around single-field form submission

--- src-cljs/frontend/components/pieces/form.cljs
+++ src-cljs/frontend/components/pieces/form.cljs
@@ -172,6 +172,18 @@
     (component
       (html
        [:form
+        ;; WORKAROUND: When a form contains exactly one field, pressing
+        ;; Return/Enter in that field submits the form. This is an old and
+        ;; quirky browser behavior designed to support things like search boxes
+        ;; without submit buttons. For us, it just makes it hard to handle
+        ;; things, since we take a more hands-on approach to submission. An
+        ;; actual form submission simply reloads the page, discarding the user's
+        ;; input. It's never something we want to happen.
+        ;;
+        ;; This hidden text field ensures that there's always an additional
+        ;; field in the form, disabling this behavior. It should have no other
+        ;; effect.
+        [:input {:type "text" :style {:display "none"}}]
         (js/React.Children.map (om-next/children this)
                                #(html [:.field %]))]))))


Remove unused functions from inline types

--- src/graphql_clj/validator/transformations/inline_types.clj
+++ src/graphql_clj/validator/transformations/inline_types.clj
@@ -1,20 +1,7 @@
 (ns graphql-clj.validator.transformations.inline-types
   "Inline field and parent field types for execution phase"
   (:require [graphql-clj.visitor :as v]
-            [graphql-clj.spec :as spec]
-            [clojure.spec :as s]
             [graphql-clj.box :as box]))
-
-(defn- of-kind [{:keys [kind required inner-type]} s]
-  (if (:type-name inner-type)
-    (let [base (spec/get-type-node (spec/named-spec s [(:type-name inner-type)]) s)]
-      (select-keys base [:kind :required]))
-    {:kind kind :required required :of-kind (of-kind inner-type s)}))
-
-(defn- parent-type [{:keys [spec]}]
-  (if-let [base-spec (s/get-spec spec)]
-    (if (keyword? base-spec) base-spec spec)
-    spec))

 (def whitelisted-keys
   #{:v/parentk :node-type :selection-set :type-name :field-name :name :args-fn :kind :of-kind :required :parent-type-name})


fix user_id if not found and use right key (-, not _)

--- src/greybear/pages/game.clj
+++ src/greybear/pages/game.clj
@@ -7,8 +7,10 @@

 (defn game [request game-id]
   (let [game (read-game game-id)
-        user-id (:user_id
-                 (friend/current-authentication (friend/identity request)))]
+        user-id (or (:user-id
+                     (friend/current-authentication
+                      (friend/identity request)))
+                    0)]
     (if game
       {:body
        (base-layout (str "Game #" game-id)


updating to clojure.string namespace

updating to clojure.string namespace

--- test/test_utils.clj
+++ test/test_utils.clj
@@ -1,6 +1,5 @@
 (ns test-utils
-  (:use
-     [clojure.contrib.str-utils :only (re-split re-gsub)])
+  (:require [clojure.string :as string])
   (:import (java.io File)))

 (defn refer-private [ns]
@@ -17,10 +16,10 @@
 (defn file-to-ns-string [f root-dir]
   (let [f-sep File/separator
         td-p (re-pattern (str f-sep root-dir f-sep))]
-    (re-gsub (re-pattern "_") "-"
-             (re-gsub (re-pattern f-sep) "."
+    (replace (re-pattern "_") "-"
+             (replace (re-pattern f-sep) "."
                       (remove-file-ext
-                        (last (re-split td-p (.getAbsolutePath f))))))))
+                        (last (string/split td-p (.getAbsolutePath f))))))))

 (defn file-seq-map-filter [dir mf ff]
   (filter ff (map mf (file-seq (File. dir)))))


Fix a few bugs

Fix a few bugs

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -100,8 +100,8 @@
   (get-children        [s]  "List current outputs, for debugging only.")
   (add-child-watcher!  [s w] "Add a watcher to be notified of all child sps.")

-  (subsuming-sps       [ts] "subproblems with same name, >= inp-set")
-  (add-subsuming-sp!   [ts subsuming-sp])
+  (subsuming-sps       [s] "subproblems with same name, >= inp-set")
+  (add-subsuming-sp!   [s subsuming-sp])

   (refine-input        [s refined-input-set] "Return a child sp. Must have output.")

@@ -160,13 +160,13 @@
   (add-child-watcher!  [s w]
     (.add child-watchers w)
     (doseq [c (get-children s)] (swap! *out-count* inc) (w s c)))
-  (add-sp-child!*      [s c]
-    (assert (and (not (identical? s c)) (get-output-set c)))
+  (add-sp-child!*      [s c] ;; TODO: wait if output not set yet, send them above?
+    (util/assert-is (and (not (identical? s c)) (get-output-set s) (get-output-set c)))
     (.add child-list c)
     (summaries/summary-changed-local! s)
     (when (underived? s)
       (summaries/connect! (sp-ts s) (sp-ts c))
-      (summaries/summary-changed! (sp-ts s)))
+      (summaries/summary-changed! (sp-ts s))) ;; TODO: remove this overhead from atomic.
     (doseq [w (doall (seq child-watchers))] (swap! *out-count* inc) (w s c)))

   (subsuming-sps [s] (keys subsuming-sp-set))
@@ -230,7 +230,7 @@
      (fn [s ni] ;; Note ni may have different context.
        (if (= ni inp-set) s
          (let [subsumed-sp (ri-fn s ni)]
-           (add-subsuming-sp! (sp-ts subsumed-sp) s)
+           (add-subsuming-sp! subsumed-sp s)
            subsumed-sp))))]
    summaries/Summarizable (summarize [s] (summary-fn s))))

@@ -351,7 +351,7 @@
   (make-wrapped-subproblem
    (oc-name (sp-name inner-sp)) (input-set inner-sp) #{:Atomic :Pair} inner-sp
    identity
-   (fn child-watch [sp child-sp]
+   (fn child-watch [sp child-sp] #_ (println inner-sp sp child-sp)
      (if (=-state-sets (get-output-set! inner-sp) (get-output-set! child-sp))
        (do (connect-and-watch! sp child-sp nil #(child-watch sp %2))
            (summaries/summary-changed! sp))
@@ -363,7 +363,7 @@
        s
        (if (= :Atomic (first (sp-name inner-sp)))
          (let [ret (get-subproblem (sp-name s) ni)]
-           (add-subsuming-sp! (sp-ts ret) inner-sp) ;; TODO: new syntax?
+           (add-subsuming-sp! ret inner-sp)
            ret)
          (make-output-collecting-subproblem (refine-input inner-sp ni)))))))

@@ -501,3 +501,12 @@

 ; (dotimes [_ 1] (reset! summaries/*summary-count* 0) (reset! da/*out-count* 0) (reset! dao/*out-count* 0) (debug 0 (let [h (make-nav-switch-hierarchy (make-random-nav-switch-env 2 1 0) true)]  (time (println (run-counted #(identity (da/implicit-dash-a* h :gather false :d false :s nil))) @summaries/*summary-count* @da/*out-count*)) (time (println (run-counted #(identity (dao/implicit-dash-a*-opt h :gather false :d false :s nil))) @summaries/*summary-count*  @dao/*out-count*)) )))

+
+
+;; tODODS:
+
+;; (dotimes [_ 1] (reset! summaries/*summary-count* 0) (reset! summaries-old/*summary-count* 0) (reset! da/*out-count* 0) (reset! dao/*out-count* 0) (debug 0 (let [opts [:gather false :d false :s nil :dir :right] h (make-discrete-manipulation-hierarchy  (make-random-hard-discrete-manipulation-env 1 4))]  (time (println (run-counted #(identity (apply da/implicit-dash-a* h opts))) @summaries/*summary-count* @da/*out-count*))  (time (println (run-counted #(identity (apply dao/implicit-dash-a*-opt h opts))) @summaries-old/*summary-count*  @dao/*out-count*)) )))
+
+;; (dotimes [_ 1] (reset! summaries/*summary-count* 0) (reset! summaries-old/*summary-count* 0) (reset! da/*out-count* 0) (reset! dao/*out-count* 0) (debug 0 (let [opts [:gather true :d true :s :eager :dir :right] h (make-nav-switch-hierarchy (make-random-nav-switch-env 2 1 0) true)]  (time (println (run-counted #(identity (apply da/implicit-dash-a* h opts))) @summaries/*summary-count* @da/*out-count*))  (time (println (run-counted #(identity (apply dao/implicit-dash-a*-opt h opts))) @summaries-old/*summary-count*  @dao/*out-count*)) )))
+
+;; Deal with children-before-outputs in atomic.


space cleanup

space cleanup

--- test/celestial/integration/puppet.clj
+++ test/celestial/integration/puppet.clj
@@ -39,6 +39,3 @@
       (let [s3-redis (assoc-in redis-type [:puppet-std :module :src] "s3://opsk-sandboxes/redis-sandbox-0.3.4.tar.gz")]
         path => truthy
         (run-cycle puppet-ami s3-redis)))
-
-
-


New test: test-new-file-1

New test: test-new-file-1

--- test/clj_fileutils/fileutils_test.clj
+++ test/clj_fileutils/fileutils_test.clj
@@ -26,7 +26,7 @@

 ;
-; Actual tests.
+; Test for function definitions.
 ;

 (deftest test-print-slurp-exception-existence
@@ -64,3 +64,20 @@
     (testing "if the clj-fileutils.fileutils/make-temporary-directory function definition exists."
         (is (callable? 'clj-fileutils.fileutils/make-temporary-directory))))

+;
+; Actual tests.
+;
+
+(def msg-start
+    "Warning: cannot read content of the following file: ")
+
+(deftest test-new-file-1
+    "Check the function clj-fileutils.fileutils/new-file."
+    (testing "Check the function clj-fileutils.fileutils/new-file."
+        (are [x y] (= x y)
+            ""            (.toString (new-file ""))
+            "abc"         (.toString (new-file "abc"))
+            "abc.def"     (.toString (new-file "abc.def"))
+            "abc/def"     (.toString (new-file "abc/def"))
+            "abc/def/xyz" (.toString (new-file "abc/def/xyz")))))
+


lets tests pass

lets tests pass

--- test/clojure_playground/core_test.clj
+++ test/clojure_playground/core_test.clj
@@ -3,5 +3,5 @@
             [clojure-playground.core :refer :all]))

 (deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
+  (testing "Always passes."
+    (is (= 1 1))))


re-write unit test to get around strange test failure on circleci.

--- test/metabase/models/session_test.clj
+++ test/metabase/models/session_test.clj
@@ -2,23 +2,28 @@
   (:require [expectations :refer :all]
             [korma.core :as k]
             [metabase.models.session :refer :all]
+            [metabase.models.user :refer [User]]
+            [metabase.test.util :refer :all]
             [metabase.test.data.users :refer :all]))

 ;; first-session-for-user
 (expect
   "the-greatest-day-ever"
-  (do
+  (with-temp User [{:keys [id]} {:first_name (random-name)
+                                 :last_name  (random-name)
+                                 :email      (str (random-name) "@metabase.com")
+                                 :password   "nada"}]
     (k/insert Session
               (k/values [{:id         "the-greatest-day-ever"
-                          :user_id    (user->id :rasta)
+                          :user_id    id
                           :created_at (metabase.util/->Timestamp "1980-10-19")}
                          {:id         "the-world-of-bi-changes-forever"
-                          :user_id    (user->id :rasta)
+                          :user_id    id
                           :created_at (metabase.util/->Timestamp "2015-10-21")}
                          {:id         "something-could-have-happened"
-                          :user_id    (user->id :rasta)
+                          :user_id    id
                           :created_at (metabase.util/->Timestamp "1999-12-31")}
                          {:id         "now"
-                          :user_id    (user->id :rasta)
+                          :user_id    id
                           :created_at (metabase.util/new-sql-timestamp)}]))
-    (first-session-for-user (user->id :rasta))))
+    (first-session-for-user id)))


pass find nodes in page

pass find nodes in page

--- test/synthesis_crawlers/core_test.clj
+++ test/synthesis_crawlers/core_test.clj
@@ -135,24 +135,21 @@
 (deftest find-nodes-in-page-test
   (testing "Finds nodes in a page."
     (let [text "
hoge
bar foo"
-          nodes (Jsoup/parse text)
-          result (find-nodes-in-page {"http://foobar.com" text
-                                      "http://piyo.com" ""}
-                                 {:title #{"hoge" "piyo"}})]
-      (println result)
-      (is (s/valid? (s/map-of string?
-                              (s/map-of keyword?
-                                        (s/coll-of #(instance? Element %))))
-                    result))
-      (is (= (count (:title (result "http://foobar.com"))) 1))
-      (is (= (result "http://piyo.com") {:title []}))))
-  (testing "test case2"
+          nodes (Jsoup/parse text)]
+      (is (= (find-nodes-in-page {"http://foobar.com" text
+                                  "http://piyo.com" ""}
+                                 {:title #{"hoge" "piyo"}})
+             {"http://foobar.com" {:title #{"html > body > div"}}
+              "http://piyo.com" {:title #{}}}))))
+  (testing "each returned node isn't reachable from other nodes
+           as long as they are in the same attribute set"
     (is (= (find-nodes-in-page
              {"http://example.com/1"
               (slurp "dev-resources/synthesis_crawlers/generate-extractor/sample1.html")}
              {:food #{"bacon" "batter" "black beans"}
               :date #{"2016-10-02"}})
-           "to be implemented"))))
+           {"http://example.com/1" {:food #{"html > body > article > div > div"}
+                                    :date #{"html > body > article > div > span"}}}))))

 #_(deftest find-nodes-test
   (testing "finds nodes in the specified page."


cleanup service edit layout

cleanup service edit layout

--- src/cljs/swarmpit/component/service/edit.cljs
+++ src/cljs/swarmpit/component/service/edit.cljs
@@ -13,6 +13,7 @@
             [swarmpit.component.service.form-variables :as variables]
             [swarmpit.component.service.form-labels :as labels]
             [swarmpit.component.service.form-deployment :as deployment]
+            [swarmpit.component.service.form-deployment-placement :as placement]
             [swarmpit.component.message :as message]
             [swarmpit.routes :as routes]
             [rum.core :as rum]))
@@ -55,24 +56,72 @@
                        (str "Service update failed. Reason: " (:error response))))})))

 (defn- init-state
-  [item]
-  (state/set-value (select-keys item [:registry :repository :version :serviceName :mode :replicas]) settings/cursor)
-  (state/set-value (:ports item) ports/cursor)
-  (state/set-value (:networks item) networks/cursor)
-  (state/set-value (:mounts item) mounts/cursor)
-  (state/set-value (:secrets item) secrets/cursor)
-  (state/set-value (:variables item) variables/cursor)
-  (state/set-value (:labels item) labels/cursor)
-  (state/set-value (:deployment item) deployment/cursor))
+  [service networks]
+  (state/set-value (select-keys service [:registry :repository :version :serviceName :mode :replicas]) settings/cursor)
+  (state/set-value (:ports service) ports/cursor)
+  (state/set-value (->> networks
+                        (map #(select-keys % [:networkName]))
+                        (into [])) networks/cursor)
+  (state/set-value (:mounts service) mounts/cursor)
+  (state/set-value (:secrets service) secrets/cursor)
+  (state/set-value (:variables service) variables/cursor)
+  (state/set-value (:labels service) labels/cursor)
+  (state/set-value (:deployment service) deployment/cursor))

 (def init-state-mixin
   (mixin/init
-    (fn [{:keys [service]}]
-      (init-state service))))
+    (fn [{:keys [service networks]}]
+      (init-state service networks)
+      (mounts/volumes-handler)
+      (networks/networks-handler)
+      (secrets/secrets-handler)
+      (placement/placement-handler))))
+
+(rum/defc form-settings < rum/static []
+  [:div.form-service-edit-group
+   (comp/form-section "General settings")
+   (settings/form true)])
+
+(rum/defc form-ports < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section-add "Ports" ports/add-item)
+   (ports/form-update)])
+
+(rum/defc form-networks < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section-add "Networks" networks/add-item)
+   (networks/form-update)])
+
+(rum/defc form-mounts < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section-add "Mounts" mounts/add-item)
+   (mounts/form-update)])
+
+(rum/defc form-secrets < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (if (empty? @secrets/secrets)
+     (comp/form-section "Secrets")
+     (comp/form-section-add "Secrets" secrets/add-item))
+   (secrets/form-update)])
+
+(rum/defc form-variables < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section-add "Environment variables" variables/add-item)
+   (variables/form-update)])
+
+(rum/defc form-labels < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section-add "Labels" labels/add-item)
+   (labels/form-update)])
+
+(rum/defc form-deployment < rum/static []
+  [:div.form-service-edit-group.form-service-group-border
+   (comp/form-section "Deployment")
+   (deployment/form)])

 (rum/defc form < rum/static
                  init-state-mixin [data]
-  (let [{:keys [secrets volumes placement service]} data]
+  (let [{:keys [service]} data]
     [:div
      [:div.form-panel
       [:div.form-panel-left
@@ -90,29 +139,11 @@
            {:href  (routes/path-for-frontend :service-info (select-keys service [:id]))
             :label "Back"}))]]
      [:div.form-service-edit
-      [:div.form-service-edit-group
-       (comp/form-section "General settings")
-       (settings/form true)]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section-add "Ports" ports/add-item)
-       (ports/form-update)]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section "Networks")
-       (networks/form-update (:networks service))]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section-add "Mounts" mounts/add-item)
-       (mounts/form-update volumes)]
-      [:div.form-service-edit-group.form-service-group-border
-       (if (empty? secrets)
-         (comp/form-section "Secrets")
-         (comp/form-section-add "Secrets" secrets/add-item))
-       (secrets/form-update secrets)]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section-add "Environment variables" variables/add-item)
-       (variables/form-update)]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section-add "Labels" labels/add-item)
-       (labels/form-update)]
-      [:div.form-service-edit-group.form-service-group-border
-       (comp/form-section "Deployment")
-       (deployment/form placement)]]]))+      (form-settings)
+      (form-ports)
+      (form-networks)
+      (form-mounts)
+      (form-secrets)
+      (form-variables)
+      (form-labels)
+      (form-deployment)]]))


added note to self

added note to self

--- src/clojure/staircase/resources/histories.clj
+++ src/clojure/staircase/resources/histories.clj
@@ -66,7 +66,9 @@
         (sql/delete! conn :history_step
                      ["history_id=?" uuid])
         (sql/delete! conn :histories
-                     ["id=? and owner=?" uuid (:user staircase.resources/context)])))
+                     ["id=? and owner=?" uuid (:user staircase.resources/context)])
+        ;; TODO - delete orphaned steps?
+        ))
     nil)

   (create [histories doc]


Refactor thread

Refactor thread

--- src/braid/core/client/ui/views/thread.cljs
+++ src/braid/core/client/ui/views/thread.cljs
@@ -130,21 +130,6 @@
                        :uploading? false})
         set-uploading! (fn [bool] (swap! state assoc :uploading? bool))
         set-dragging! (fn [bool] (swap! state assoc :dragging? bool))
-
-        thread-private? (fn [thread] (and
-                                       (seq (thread :messages))
-                                       (empty? (thread :tag-ids))
-                                       (seq (thread :mentioned-ids))))
-
-        thread-limbo? (fn [thread] (and
-                                     (seq (thread :messages))
-                                     (empty? (thread :tag-ids))
-                                     (empty? (thread :mentioned-ids))))
-
-        ; Closing over thread-id, but the only time a thread's id changes is the new
-        ; thread box, which is always open
-        open? (subscribe [:thread-open? (thread :id)])
-        focused? (subscribe [:thread-focused? (thread :id)])
         maybe-upload-file!
         (fn [thread file]
           (if (> (.-size file) max-file-size)
@@ -165,15 +150,23 @@

     (fn [thread]
       (let [{:keys [dragging? uploading?]} @state
-            private? (thread-private? thread)
-            limbo? (thread-limbo? thread)
-            archived? (not @open?)]
+            open? @(subscribe [:thread-open? (thread :id)])
+            focused? @(subscribe [:thread-focused? (thread :id)])
+            private? (and
+                       (seq (thread :messages))
+                       (empty? (thread :tag-ids))
+                       (seq (thread :mentioned-ids)))
+            limbo?  (and
+                      (seq (thread :messages))
+                      (empty? (thread :tag-ids))
+                      (empty? (thread :mentioned-ids)))
+            archived? (not open?)]

         [:div.thread
          {:class
           (string/join " " [(when private? "private")
                             (when limbo? "limbo")
-                            (when @focused? "focused")
+                            (when focused? "focused")
                             (when dragging? "dragging")
                             (when archived? "archived")])


[base] Support nil for :command fx

[base] Support nil for :command fx

--- src/braid/base/client/events.cljs
+++ src/braid/base/client/events.cljs
@@ -51,22 +51,23 @@
             {:keys [on-success on-error]
              :or {on-success (constantly nil)
                   on-error (fn [err]
-                             (.error js/console "tada.rpc request error: " (pr-str err)))}}]]
-          (socket/chsk-send!
-            [event-id event-params]
-            1000
-            (fn [reply]
-              (cond
-                ;; websocket error
-                (#{:chsk/closed :chsk/timeout :chsk/error} reply)
-                (on-error reply)
+                             (.error js/console "tada.rpc request error: " (pr-str err)))}} :as event]]
+          (when event
+            (socket/chsk-send!
+              [event-id event-params]
+              1000
+              (fn [reply]
+                (cond
+                  ;; websocket error
+                  (#{:chsk/closed :chsk/timeout :chsk/error} reply)
+                  (on-error reply)

-                ;; tada/cqrs error
-                (:cqrs/error reply)
-                (on-error (:cqrs/error reply))
+                  ;; tada/cqrs error
+                  (:cqrs/error reply)
+                  (on-error (:cqrs/error reply))

-                :else
-                (on-success reply))))))
+                  :else
+                  (on-success reply)))))))

 (defonce initial-user-data-handlers
   (hooks/register! (atom []) [fn?]))


Reclamation Order shouldn't be able to target copies of itself

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -452,7 +452,9 @@
    "Reclamation Order"
    {:prompt "Choose a card from Archives" :msg (msg "add copies of " (:title target) " to HQ")
     :show-discard true
-    :choices {:req #(and (= (:side %) "Corp") (= (:zone %) [:discard]))}
+    :choices {:req #(and (= (:side %) "Corp")
+                         (not= (:title %) "Reclamation Order")
+                         (= (:zone %) [:discard]))}
     :effect (req (doseq [c (filter #(= (:title target) (:title %)) (:discard corp))]
                    (move state side c :hand)))}


WIP: pass stroke/fill/line options down from render-env.

--- src/cljc/mazes/renderers/svg.cljc
+++ src/cljc/mazes/renderers/svg.cljc
@@ -17,12 +17,6 @@
              :width 1000
              :height 800}})

-(def default-render-environment-options
-  {:width (:width default-svg-attributes)
-   :height (:height default-svg-attributes)
-   :margin 20
-   :size-spacing-ratio 0.75})
-
 (def default-stroke-attributes
   {:stroke "black"
    :stroke-width 20
@@ -31,13 +25,24 @@

 (def default-rect-attributes
   (merge default-stroke-attributes
-         {:fill-opacity 0}))
+         {:fill-opacity 1.0}))
+
+; In principle, may differ from stroke attributes.
+(def default-line-attributes default-stroke-attributes)
+
+(def default-render-environment-options
+  {:width (:width default-svg-attributes)
+   :height (:height default-svg-attributes)
+   :margin 20
+   :size-spacing-ratio 0.5
+   :rect-attributes default-rect-attributes
+   :line-attributes default-line-attributes})

 (defn rect [attributes]
-  [:rect (merge attributes default-rect-attributes)])
+  [:rect (merge default-rect-attributes attributes)])

 (defn line [attributes]
-  [:line (merge attributes default-stroke-attributes)])
+  [:line (merge default-stroke-attributes attributes)])

 (defn svg
   "Given a render environment generated by render-environment, returns an SVG
@@ -68,15 +73,21 @@
       A higher margin will leave less space for cells.
     :viewbox - Optional. A map with :x, :y, :width, and :height keys. Used to
       generate the SVG viewbox attribute string.
+    :rect-attributes - Optional. A map of SVG attributes to be applied to all rects.
+    :line-attributes - Optional. A map of SVG attributes to be applied to all lines.

   Values returned:
     :grid - The grid which is being rendered; rendering functions may use this
       for additional information. For instance, drawing connections between
       rooms is simplified when grid/find-cell is available.
+
     :width - Passed through from input options.
     :height - Passed through from input options.
     :viewbox - Passed through from input options.
     :margin - Passed through from input options.
+    :rect-attributes - Passed through from input options.
+    :line-attributes - Passed through from input options.
+
     :cell-width - The width of each cell to be rendered.
     :cell-height - The height of each cell to be rendered.
     :cell-h-spacing - The horizontal space between each cell.
@@ -145,7 +156,7 @@
   :ret (spec/coll-of number? :min-count 2 :max-count 2))

 (defn render-rect [render-env cell]
-  (rect (room-geometry render-env cell)))
+  (rect (merge (:rect-attributes render-env) (room-geometry render-env cell))))

 (defn render-line [render-env cell direction]
   (let [start-room (room-geometry render-env cell)
@@ -153,7 +164,8 @@
         end-room (room-geometry render-env end-cell)
         [x1 y1] (anchor-point start-room direction)
         [x2 y2] (anchor-point end-room (direction grid/converse-directions))]
-    (line {:x1 x1, :y1 y1, :x2 x2, :y2 y2})))
+    (line (merge (:line-attributes render-env)
+                 {:x1 x1, :y1 y1, :x2 x2, :y2 y2}))))
 (spec/fdef render-line
   :args (spec/cat :render-env map? :cell ::grid/cell :direction ::grid/direction)
   :ret vector?)


Add validation checks to Event Add

Add validation checks to Event Add

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -564,9 +564,10 @@

             create-event
             (fn [form]
-              (events-endpoint :create
-                               form
-                               #(set! js/location (events-explore-route))))]
+              (when (empty? errors)
+                (events-endpoint :create
+                                 form
+                                 #(set! js/location (events-explore-route)))))]
         [:div.sixteen.wide.column
          [:div.ui.segment
           [:form.ui.form
@@ -608,8 +609,9 @@
              [:label "Description"]
              [input-atom :textarea
               (r/wrap Description swap! form assoc :Description)]]
-            [:button.ui.primary.button
-             {:type :submit :on-click #(create-event @form)}
+            [:button.ui.primary.button {:class (when (seq errors) "disabled")
+                                        :type :submit
+                                        :on-click #(create-event @form)}
              "Add"]]]]]))))

 (defn event-register-page [event-id]


move refactoring

move refactoring

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -86,7 +86,7 @@
 (defn- to-game-transition
   [board moves]
   {:transition moves
-   :scores 0                         ;; TODO - Put a score diff (more by player, less by player)
+   :scores 0                                                ;; TODO - Put a score diff (more by player, less by player)
    :board (delay (apply-conversions board moves))})

 (defn- add-empty-cell-conversion
@@ -118,10 +118,8 @@

 (defn map-values
   "Apply a function to the values of a key-value collection"
-  [xf coll]
-  (into {}
-    (map (fn [[k v]] [k (xf v)]))
-    coll))
+  ([xf] (map (fn [[k v]] [k (xf v)])))
+  ([xf coll] (into {} (map-values xf) coll)))

 (defn available-transitions
   [board]
@@ -131,7 +129,6 @@

     (transduce
       (mapcat #(available-conversions-at board %))          ;; TODO - Cut that in two? (moves vs transitions)
-      (group-by-reducer :winner :point)
+      (group-by-reducer :winner :point)                     ;; TODO - Move the game computation into turn computation for next turn
       (board/empty-cells board))
     ))
-


experimenting with better transitions

experimenting with better transitions

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -15,7 +15,7 @@
 (s/def ::taken (s/coll-of ::board/coord))
 (s/def ::winner ::player/player)
 (s/def ::looser ::player/playable-cell)
-(s/def ::conversion  (s/keys :req-un [::point ::taken ::winner ::looser]))
+(s/def ::conversion (s/keys :req-un [::point ::taken ::winner ::looser]))
 (s/def ::available-moves
   (s/map-of ::player/player
     (s/map-of ::board/coord
@@ -42,11 +42,11 @@
          taken []]
     (let [cell (board/get-cell-at board coord)]
       (cond
-        (is-not-convertible? cell) nil                        ;; No move: reached end and only 1 type of cell
-        (and looser (not= looser cell)) {:winner cell         ;; Who wins the cells
-                                         :looser looser       ;; Who looses the cells
-                                         :point init-coord    ;; The move performed
-                                         :taken taken}        ;; The cells taken
+        (is-not-convertible? cell) nil                      ;; No move: reached end and only 1 type of cell
+        (and looser (not= looser cell)) {:winner cell       ;; Who wins the cells
+                                         :looser looser     ;; Who looses the cells
+                                         :point init-coord  ;; The move performed
+                                         :taken taken}      ;; The cells taken
         :else (recur
                 (next-coord coord)
                 cell
@@ -86,12 +86,12 @@

 #_(s/fdef all-available-moves
-  :args (s/tuple ::board/board)
-  :ret ::available-moves)
+    :args (s/tuple ::board/board)
+    :ret ::available-moves)

 #_(s/fdef apply-conversion
-  :args (s/tuple ::board/board ::conversion)
-  :ret ::board/board)
+    :args (s/tuple ::board/board ::conversion)
+    :ret ::board/board)

 (defn all-available-moves
@@ -100,7 +100,7 @@
   (dissoc
     (transduce
       (mapcat #(available-conversions-at board %))
-      #(update-in %1 [(:winner %2) (:point %2)] conj %2)
+      #(update-in %1 [(:winner %2) (:point %2)] conj %2)    ;; TODO - List of conversions
       {}
       (board/empty-cells board))
     nil))                                                   ;; TODO - find why we have nil
@@ -114,3 +114,28 @@
       board
       (conj moves (empty-cell-conversion (:winner move) (:point move)))
       )))
+
+
+;; (require '[clojure.test.check.generators :as gen])
+;; (def b (first (gen/sample (s/gen ::board/board) 1)))
+
+(defn available-transitions
+  [board]
+  (map
+
+    (fn [[winner moves-by-pos]]
+      [winner
+       (into {}
+         (map (fn [[pos moves]]
+                [pos {:transition moves
+                      :board (delay (apply-conversions board moves))}]
+                ))
+         moves-by-pos)
+       ])
+
+    (transduce
+      (mapcat #(available-conversions-at board %))
+      #(update-in %1 [(:winner %2) (:point %2)] conj %2)    ;; TODO - List of conversions
+      {}
+      (board/empty-cells board)))
+  )


rpm: ensure binaries & startup config belong to root

--- tasks/leiningen/fatrpm.clj
+++ tasks/leiningen/fatrpm.clj
@@ -99,6 +99,8 @@
        [; Jar
         {:directory "/usr/lib/riemann/"
          :filemode "644"
+         :username "root"
+         :groupname "root"
          :sources [(source (str (file (:root project)
                                       "target"
                                       (str "riemann-"
@@ -109,6 +111,8 @@
         ; Binary
         {:directory "/usr/bin"
          :filemode "755"
+         :username "root"
+         :groupname "root"
          :sources [(source (file (:root project) "pkg" "rpm" "riemann")
                            "riemann")]}

@@ -132,6 +136,8 @@
         ; Default file
         {:directory "/etc/sysconfig"
          :filemode "644"
+         :username "root"
+         :groupname "root"
          :configuration true
          :sources [(source (file (:root project) "pkg" "riemann-default")
                            "riemann")]}


Better pos set/get functions

Better pos set/get functions

--- clojure/src/life/core.clj
+++ clojure/src/life/core.clj
@@ -16,13 +16,22 @@
         flat (s/join "\n" (map #(s/join " " %) lines))]
     (println flat)))

+(defn pos [[x y]]
+  (+ x (* board-size y)))
+
+(defn get-p [m p]
+  (get m (pos p)))
+
+(defn set-p [m p v]
+  (assoc m (pos p) v))
+
 (defn add-glider [board]
   (-> board
-      (assoc (pos 1 0) 1)
-      (assoc (pos 2 1) 1)
-      (assoc (pos 2 2) 1)
-      (assoc (pos 0 2) 1)
-      (assoc (pos 1 2) 1)))
+      (set-p [1 0] 1)
+      (set-p [2 1] 1)
+      (set-p [2 2] 1)
+      (set-p [0 2] 1)
+      (set-p [1 2] 1)))

 (defn setup []
   (q/frame-rate 1)
@@ -31,15 +40,12 @@
 (defn update-state [state]
   state)

-(defn pos [x y]
-  (+ x (* board-size y)))
-
 (defn draw-state [state]
   (q/no-stroke)
   (doall
    (for [x (range board-size)
          y (range board-size)]
-     (let [cell (get (:board state) (pos x y))
+     (let [cell (get-p (:board state) [x y])
            color (state->color cell)]
        (apply q/fill color)
        (q/rect (* x cell-size)


Add IURLable and IURIable protocols.

Add IURLable and IURIable protocols.

--- src/common/grafter/common/url.clj
+++ src/common/grafter/common/url.clj
@@ -4,6 +4,14 @@

   (:import [java.net URL URI]
            [org.openrdf.model.impl URIImpl]))
+
+(defprotocol IURLable
+  (->url [url]
+    "Convert into a java.net.URL"))
+
+(defprotocol IURIable
+  (->uri [url]
+    "Convert into a java.net.URI"))

 (defprotocol IURL
   (set-host [url host])
@@ -25,10 +33,10 @@
     "Adds the map of key value pairs to the query params.  Sorts the
     keys first to help provide guarantee's around URL equality.")
   (query-params [url])
-  (->url [url]
-    "Convert into a java.net.URI")
-  (->uri [url]
-    "Convert into a java.net.URI"))
+
+  ;; Implementations should also implement IURLable and IURIable
+
+  )

 (defn parse-path [path-str]
   (when-not (#{nil ""} path-str)


Added subsethood

Added subsethood

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

--- src/conexp/contrib/fuzzy/sets.clj
+++ src/conexp/contrib/fuzzy/sets.clj
@@ -7,7 +7,8 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.contrib.fuzzy.sets
-  (:use conexp.main))
+  (:use conexp.main
+        conexp.contrib.fuzzy.logics))

 (ns-doc "Basic definitions for fuzzy sets")

@@ -151,4 +152,15 @@

 ;;;

+(defn subsethood
+  "Returns the degree to which fuzzy-set-1 is a subset of
+  fuzzy-set-2."
+  [fuzzy-set-1 fuzzy-set-2]
+  (reduce (fn [result element]
+            (f-and result (f-impl (fuzzy-set-1 element) (fuzzy-set-2 element))))
+          1
+          (keys (fuzzy-set-as-hashmap fuzzy-set-1))))
+
+;;;
+
 nil


don't let dropping arrow onto empty canvas break things

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -683,6 +683,7 @@
       (assoc-in [:camera :moving?] false))))

+;; should only get here if we ended on empty canvas
 (defn finalize-relation [state]
   (let [{:keys [x y]} (get-in state [:mouse])
         [rx ry] (cameras/screen->point (:camera state) x y)
@@ -693,7 +694,7 @@
       (update-in [:drawing] assoc :relation-in-progress? false)
       (assoc-in [:mouse-down] false)
       (assoc-in [:drawing :relation] {})
-      (assoc-in [:drawing :finished-relation] {:origin-layer origin-layer
+      #_(assoc-in [:drawing :finished-relation] {:origin-layer origin-layer
                                                :dest-layer-id dest-layer-id})
       (assoc-in [:camera :moving?] false))))


Get ns load request to client's RPC

Get ns load request to client's RPC

--- src/clj/com/frereth/web/routes/websock.clj
+++ src/clj/com/frereth/web/routes/websock.clj
@@ -149,35 +149,50 @@

 (s/defn request-ns-load!
   [this :- WebSockHandler
-   {:keys [module-name macro? path world] :as data}]
+   {:keys [module-name macro? path request-id world] :as data}
+   on-success]
   ;; Q: Does it make sense to spawn the thread here? Or in the caller?
   ;; A: It depends on whether these handlers should always run in their
   ;; own thread, of course.
   ;; For that matter, it might make the most sense to just pass a
   ;; parameter to rpc to decide whether to spawn a new thread or not
-  (async/thread
-    (let [mgr (-> this :frereth-server :connection-manager)
-          response
-              (manage
-           (con-man/rpc-sync world
-                        :frereth/load-ns
-                        (select-keys [module-name macro? path]))
-           ;; For now, just insert handlers directly into the code
-           ;; to be compiled
-           ;; TODO: Come up w/ a better strategy
-           ;; If nothing else, this sort of thing seems like it would be
-           ;; more appropriate in the client.
-           ;; Except that, as far as the client is concerned, there's
-           ;; no real hint about what we're doing.
-           ;; So maybe this should be a wrapper in there around rpc
-           ;; Get it working first, then worry about getting it to work
-           ;; correctly.
-           (on :timeout []
-               {:script '(raise :timeout)}))]
-      (reply this
-             data
-             :frereth/loaded-ns
-             response))))
+  (log/debug "Requesting namespace load:\n" (keys data))
+  (let [background-thread
+        (async/go
+          (let [mgr (-> this :frereth-server :connection-manager)
+                response
+                (manage
+                 (let [result
+                       (con-man/rpc-sync this
+                                         world
+                                         :frereth/load-ns
+                                         (select-keys data [:module-name :macro? :path]))]
+                   (log/debug "rpc-sync returned" result)
+                   result)
+                 ;; For now, just insert handlers directly into the code
+                 ;; to be compiled
+                 ;; TODO: Come up w/ a better strategy
+                 ;; If nothing else, this sort of thing seems like it would be
+                 ;; more appropriate in the client.
+                 ;; Except that, as far as the client is concerned, there's
+                 ;; no real hint about what we're doing.
+                 ;; So maybe this should be a wrapper in there around rpc
+                 ;; Get it working first, then worry about getting it to work
+                 ;; correctly.
+                 (on :timeout []
+                     ;; I think my plan here was to return this to the caller to be executed on the renderer
+                     (do
+                       (log/error "Synchronous RPC call timed out")
+                       {:script '(throw (ex-info (str "Loading ns:" module-name) {:timeout true}))})))]
+            (reply this
+                   data
+                   :frereth/loaded-ns
+                   response)))]
+    ;; Really don't want to block the caller
+    (comment (let [result (async/<!! background-thread)]
+               (log/debug "rpc-sync returned: " (pr-str result))
+               result))
+    background-thread))

 (s/defn initialize-connection!
   [this :- WebSockHandler
@@ -190,7 +205,7 @@

 (s/defn event-handler
   [this :- WebSockHandler
-   {:keys [id ?data event] :as ev-msg}]
+   {:keys [id ?data event ?reply-fn] :as ev-msg}]
   (when-not (= event [:chsk/ws-ping])
     ;; The ws-ping happens every 20 seconds.
     ;; And every 2...I may be setting up multiple event loops on the client
@@ -211,8 +226,8 @@
          ;; TODO: This seems like a pretty important detail
          [:chsk/uidport-close _] (log/error "Remote port closed: need to clean up its resources")
          [:chsk/ws-ping _] (ping this ev-msg)
+         [:cljs/load-ns _] (request-ns-load! this ?data ?reply-fn)
          [:frereth/blank-slate _] (initiate-auth! this ev-msg)
-         [:frereth/load-ns _] (request-ns-load! this ev-msg)
          [:frereth/pong _] (forward this ev-msg)
          [:frereth/response _] (log/info "Response from renderer:\n"
                                          (util/pretty ?data))
@@ -224,7 +239,12 @@
 update on the fly.

 Besides, it's much more readable this way"
-  [{:keys [ch rcvr web-sock-handler] :as bundle}
+
+  [;; mish-mash because of the way this was refactored out of the middle of the loop
+   ;; ch is the channel that the request came in on
+   ;; rcvr is the channel where browser messages come from
+   ;; web-sock-handler...is probably the Component
+   {:keys [ch rcvr web-sock-handler] :as bundle}
    msg :- s/Any]
   (when-not web-sock-handler
     (log/error "Missing web socket handler in:\n" (util/pretty bundle))
@@ -262,10 +282,8 @@
            event-loop
            (async/go
              (loop []
-               (log/debug "Top of websocket event loop"  #_(util/pretty {:stopper stopper
-                                                                         :receiver rcvr
-                                                                         :ws-controller ws-controller
-                                                                         :web-sock-handler ((complement nil?) web-sock-handler)}))
+               (log/debug "Top of websocket event loop")
+
                ;; TODO: I'm pretty sure I have 5 minutes defined somewhere useful
                (let [t-o (async/timeout (* 1000 60 5))
                      [v ch] (async/alts! [t-o stopper rcvr ws-controller])]
@@ -273,7 +291,7 @@
                    (do
                      (let [event (-> v :event first)]
                        (when-not (= event :chsk/ws-ping)
-                         ;; Handle it, but don't log about it: this happens far too often
+                         ;; Handle the ping, but don't log about it: this happens far too often
                          ;; to spam the logs with the basic fact
                          (log/debug "Message to handle:\n" (util/pretty (select-keys v [:client-id :connected-uids :uid :event])))))
                      (try


commented out bad ndvi_filter code

commented out bad ndvi_filter code

--- src/clj/forma/presentation/ndvi_filter.clj
+++ src/clj/forma/presentation/ndvi_filter.clj
@@ -101,7 +101,7 @@
 ;; based on the interpolated NDVI values.

 (def plot2 (c/time-series-plot forma-range
-                               (hp-filter (make-reliable #{2} #{1} reli ndvi) 2)
+                               (hp-filter 2 (make-reliable #{2} #{1} reli ndvi))
                                :title ""
                                :x-label ""
                                :y-label ""
@@ -122,7 +122,7 @@
 (defn add-ndvi-slider []
   (let [x forma-range]
     (c/slider #(i/set-data plot2
-                           [x (hp-filter (make-reliable #{2} #{1} reli ndvi) %)])
+                           [x (hp-filter % (make-reliable #{2} #{1} reli ndvi))])
               (map (partial round-places 2)
                    (range 0 1000 1))
               "lambda")))
@@ -165,7 +165,7 @@
 (defn add-filter []
   (doto (c/add-lines plot3
                      forma-range
-                     (hp-filter (make-reliable #{2} #{1} reli ndvi) 2)
+                     (hp-filter 2 (make-reliable #{2} #{1} reli ndvi))
                      :series-label "FILTER")))

@@ -191,8 +191,8 @@
 ;;                          :y-label ""
 ;;                          :series-label ""))

-(defn add-bfast-ndvi []
-  (c/add-lines plot-efp (range (count Yt)) Yt))
+;; (defn add-bfast-ndvi []
+;;   (c/add-lines plot-efp (range (count Yt)) Yt))

 ;; (defn add-bfast-slider []
 ;;   (let [x (range (count Yt))]


Minor bug in transoform component, got fixed

--- src/clj/hellhound/components/transform.clj
+++ src/clj/hellhound/components/transform.clj
@@ -9,17 +9,19 @@

 (defn- transform-fn
   [f]
-  (fn [{:keys [input output] :as component} context]
-    (s/connect-via input
-                   #(s/put! output (f context %))
-                   output)
+  (fn [component context]
+    (let [input  (hcomp/input component)
+          output (hcomp/output component)]
+      (s/connect-via input
+                     #(s/put! output (f context %))
+                     output))
     component))

 (defn factory
   "Creates a component with the given `component-name` which transforms
   the input value by applying `f` to it and sending it to the output stream."
-  [component-name f
-   {::hcomp/name     component-name
-    ::hcomp/start-fn (transform-fn f)
-    ::hcomp/stop-fn  (fn [component] this)}])
+  [component-name f]
+  {::hcomp/name     component-name
+   ::hcomp/start-fn (transform-fn f)
+   ::hcomp/stop-fn  (fn [component] component)})


More on atoms.

More on atoms.

--- test/com/nomistech/clojure_the_language/intro_to_state.clj
+++ test/com/nomistech/clojure_the_language/intro_to_state.clj
@@ -102,8 +102,7 @@
 ;;;;         (using the current value as input to the swap function).
 ;;;;
 ;;;; - Another atom is used to keep track of how many times the swap function
-;;;;   is called. (But note that swap functions are not really supposed to
-;;;;   have side effects -- it's just for this example.)
+;;;;   is called.

 (def competing-updates-atom (atom 0))


fn-first approach for fetch fns API

fn-first approach for fetch fns API

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -273,10 +273,10 @@
   "Given a java.sql.ResultSet instance fetch a vector of rows using row-maker, an arity-2 function that accepts
   java.sql.ResultSet and column-count, and by default returns a vector of column values."
   ([^ResultSet result-set]
-    (fetch-rows result-set i/read-result-row nil))
+    (fetch-rows i/read-result-row result-set nil))
   ([^ResultSet result-set result-column-types]
-    (fetch-rows result-set i/read-result-row result-column-types))
-  ([^ResultSet result-set row-maker ^ints result-column-types]
+    (fetch-rows i/read-result-row result-set result-column-types))
+  ([row-maker ^ResultSet result-set ^ints result-column-types]
     (let [rows (transient [])]
       (if (seq result-column-types)
         (while (.next result-set)
@@ -292,10 +292,10 @@
   "Given a java.sql.ResultSet instance ensure it has exactly one row and fetch it using row-maker, an arity-2 function
   that accepts java.sql.ResultSet and column-count, and by default returns a vector of column values."
   ([^ResultSet result-set]
-    (fetch-single-row result-set i/read-result-row nil))
+    (fetch-single-row i/read-result-row result-set nil))
   ([^ResultSet result-set result-column-types]
-    (fetch-single-row result-set i/read-result-row result-column-types))
-  ([^ResultSet result-set row-maker ^ints result-column-types]
+    (fetch-single-row i/read-result-row result-set result-column-types))
+  ([row-maker ^ResultSet result-set ^ints result-column-types]
     (if (.next result-set)
       (let [row (if (seq result-column-types)
                   (row-maker result-set result-column-types)
@@ -312,10 +312,10 @@
   "Given a java.sql.ResultSet instance ensure it has exactly one row and one column, and fetch it using column-reader,
   an arity-1 function that accepts java.sql.ResultSet and returns the column value."
   ([^ResultSet result-set]
-    (fetch-single-value result-set i/read-column-value nil))
+    (fetch-single-value i/read-column-value result-set nil))
   ([^ResultSet result-set result-column-types]
-    (fetch-single-value result-set i/read-column-value result-column-types))
-  ([^ResultSet result-set column-reader ^ints result-column-types]
+    (fetch-single-value i/read-column-value result-set result-column-types))
+  ([column-reader ^ResultSet result-set ^ints result-column-types]
     (let [^ResultSetMetaData rsmd (.getMetaData result-set)
           column-count (.getColumnCount rsmd)]
       (when (not= 1 column-count)


logging and comments

logging and comments

--- src/babel/latin.cljc
+++ src/babel/latin.cljc
@@ -6,6 +6,7 @@
             [babel.encyclopedia :as encyc]
             [clojure.java.io :refer [resource]]
             [clojure.repl :refer [doc]]
+            [clojure.tools.logging :as log]
             [dag_unify.core :refer [fail? get-in strip-refs unifyc]]))

 (defn edn2lexicon [resource]
@@ -78,12 +79,21 @@

 (defn get-spec [base-spec]
   "return a spec that is more specific than base-spec, specific enough to conjugate."
+  (log/debug (str "get-spec:base-spec:" base-spec ";subj: " (get-in base-spec [:synsem :subj :pred])))
   (unifyc
    base-spec
+
+   ;; Read 'em their rights:
+   ;;
+   ;; 1. You have the right to a tense. if you do not have one,
+   ;; get-spec will appoint one for you.
    (or (and (get-in base-spec [:synsem :sem :tense])
             base-spec)
        {:synsem {:sem (first (shuffle tenses))}})
-   (or (and (get-in base-spec [:synsem :subj :pred])
+
+   ;; 2. You have the right to a subject. if you do not have one,
+   ;; get-spec will appoint one for you.
+   (or (and (get-in base-spec [:synsem :sem :subj :pred])
             base-spec)
        {:synsem {:sem {:subj {:pred (first (shuffle subjects))}}}})
    (or (and (get-in base-spec [:root])
@@ -108,8 +118,8 @@
   "choose a random spec based on the given curriculum and model"
   ;; for now, stubbed out: imagine a curriculum narrowly based on a single verb and
   ;; the imperfect tense.
-  (let [spec-for-curriculum (intersection spec curriculum model)]
-    (get-spec spec)))
+  (let [spec-from-curriculum (intersection spec curriculum model)]
+    (get-spec spec-from-curriculum)))

 (def curriculum
   {:nouns ["lui" "lei"]


whitespace

whitespace

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -180,7 +180,7 @@
        :targets [(:target pairing)]
        :target-spec target-spec
        :target-roots [(u/get-in target-expression
-                              [:root target-root-keyword target-root-keyword])]
+                                [:root target-root-keyword target-root-keyword])]
        :target-semantics (strip-refs
                           (u/get-in target-expression [:synsem :sem]))})))


Changed the way dl-expression quotes is arguments.

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

--- src/conexp/contrib/dl/framework/syntax.clj
+++ src/conexp/contrib/dl/framework/syntax.clj
@@ -111,9 +111,12 @@
   dl-expression automatically.")

 (defmacro dl-expression
-  "Allows input of DL s-expression without quoting. Symbols starting
-  with a capital letter are quoted, symbols in the first position of a
-  sequence are quoted and everything else is left as it is."
+  "Allows input of DL s-expression without quoting. The following quoting rules apply:
+
+    - function calls are not quoted (sequences starting with a symbol
+      not being in *common-constructors*
+    - capital letters are quoted (appearing outside of a function call)
+    - symbols in *common-constructors* being the first element of a sequence are quoted."
   [language expression]
   (let [transform-symbol (fn [symbol]
 			   (if (Character/isUpperCase (first (str symbol)))
@@ -125,7 +128,7 @@
 					 (empty? sexp) sexp,
 					 (contains? *common-constructors* (first sexp))
 					 (list* 'list (list 'quote (first sexp)) (walk transform identity (rest sexp))),
-					 :else (walk transform identity sexp)),
+					 :else sexp),
 		     (sequential? sexp) (walk transform identity sexp),
 		     (symbol? sexp)     (transform-symbol sexp),
 		     :else              sexp))]


Stop rotating if the main canvas is not visible anymore

Does not have any effect right now.

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

--- src/conexp/contrib/draw/control/freese.clj
+++ src/conexp/contrib/draw/control/freese.clj
@@ -55,6 +55,9 @@
               (if @rotate-thread
                 (stop-rotate)
                 (start-rotate))))
+    (listen (scene-canvas scn) :component-hidden
+            (fn [_]
+              (stop-rotate)))
     (listen frame #{:window-iconified :window-closed}
             (fn [_]
               (stop-rotate)))))


Updated test.

Updated test.

--- test/cmr/system_int_test/index_set/health_test.clj
+++ test/cmr/system_int_test/index_set/health_test.clj
@@ -10,23 +10,9 @@
   (testing "good health"
     (let [response (client/get (url/index-set-health-url)
                                {:accept :json
-                                :query-params {:token "mock-echo-system-token"}
                                 :connection-manager (url/conn-mgr)})
           health (json/decode (:body response) true)
           {:keys [elastic_search echo-rest]} health]
       (is (= 200 (:status response)))
       (is (some #{elastic_search} ["green" "yellow"]))
-      (is (= "ok" echo-rest))))
-
-  (testing "bad health"
-    (let [response (client/get (url/index-set-health-url)
-                               {:accept :json
-                                :throw-exceptions false
-                                :connection-manager (url/conn-mgr)})
-          health (json/decode (:body response) true)
-          {:keys [elastic_search echo-rest]} health]
-      (is (= 503 (:status response)))
-      (is (some #{elastic_search} ["green" "yellow"]))
-      (is (= "401 UNAUTHORIZED" echo-rest)))))
-
-
+      (is (= "ok" echo-rest)))))


reader: fix wrapping-reader bug

reader: fix wrapping-reader bug

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -545,7 +545,7 @@
 (defn wrapping-reader
   [sym]
   (fn [rdr _]
-    (list sym (read rdr true nil true) nil)))
+    (list sym (read rdr true nil true))))

 (defn throwing-reader
   [msg]


support default opts on dependencies

support default opts on dependencies

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -5,7 +5,7 @@
         [uncle.core :only [fileset-seq]]
         [clojure.string :only [join trim-newline]]
         [clojure.java.shell :only [sh]]
-        [cake.utils.useful :only [update merge-in tap]]
+        [cake.utils.useful :only [update merge-in into-map]]
         [clojure.java.io :only [reader]])
   (:import [java.io File]))

@@ -123,9 +123,10 @@
     (some #(% project) [namespace name])))

 (defn dep-map [deps]
-  (into {}
-    (for [[dep version & opts] deps]
-      [dep (apply hash-map :version version opts)])))
+  (let [[deps default-opts] (split-with (complement keyword?) deps)]
+    (into {}
+          (for [[dep version & opts] deps]
+            [dep (into-map :version version default-opts opts)]))))

 (defmulti get-version identity)


Removed class from collection elements

Removed class from collection elements

--- src/cassidy/shon.clj
+++ src/cassidy/shon.clj
@@ -95,7 +95,7 @@

 (def shon-nil (constantly "SHON.null"))
 (def shon-number (constantly "SHON.number"))
-(def shon-collection (constantly "SHON.collection"))
+(def shon-collection (constantly nil))

 ;; nil, true, false
 (extend nil                    SHONWriter


Make sure the recommendation is included in the NiG

--- src/catalog/repl.clj
+++ src/catalog/repl.clj
@@ -20,10 +20,11 @@

 (defn neu-in-grossdruck [year issue]
   (let [temp-file (java.io.File/createTempFile (format "nig-%s-%s" year issue) ".pdf")
-        editorial (db/read-editorial year issue :grossdruck)]
+        editorial (db/read-editorial year issue :grossdruck)
+        recommendation (db/read-recommendation year issue :grossdruck)]
     (-> (db/read-catalog year issue)
         vubis/order-and-group
-        (layout.fop/document :grossdruck year issue editorial nil)
+        (layout.fop/document :grossdruck year issue editorial recommendation)
         (layout.fop/generate-pdf! temp-file))))

 (defn neu-im-sortiment-fop


Remove array-eq test

Remove array-eq test

--- test/caesium/util_test.clj
+++ test/caesium/util_test.clj
@@ -1,16 +1,6 @@
 (ns caesium.util-test
   (:require [caesium.byte-bufs :as bb]
             [clojure.test :refer [are deftest testing]]))
-
-(deftest array-eq-test
-  (testing "array equality works"
-    (are [a] (bb/bytes= a a)
-      (byte-array [])
-      (byte-array [90])))
-  (testing "array inequality works"
-    (are [a b] (not (bb/bytes= a b))
-      (byte-array []) (byte-array [90])
-      (byte-array [90]) (byte-array []))))

 (deftest unhexify-test
   (testing "unhexify works"


Fix import syntax

Fix import syntax

--- test/caesium/util_test.clj
+++ test/caesium/util_test.clj
@@ -1,7 +1,6 @@
 (ns caesium.util-test
-  (:require
-   [caesium.util :as u]
-   [clojure.test :refer [deftest testing are]]))
+  (:require [caesium.util :as u]
+            [clojure.test :refer [are deftest testing]]))

 (deftest array-eq-test
   (testing "array equality works"


space

space

--- test/celestial/test/vc.clj
+++ test/celestial/test/vc.clj
@@ -1,6 +1,6 @@
 (ns celestial.test.vc
   (:require vc.provider
-    [flatland.useful.map :refer  (dissoc-in*)]
+    [flatland.useful.map :refer (dissoc-in*)]
     [clojure.core.strint :refer (<<)]
     [celestial.config :refer (config)]
     [celestial.model :refer (vconstruct)]


[Add] information of cross-validate using hash

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -127,13 +127,16 @@
    (let [test (DataSet. (data/extract-list (:classes dataset) a b)
                         (data/extract-list (:features dataset) a b))
          sample (DataSet. (data/remove-list (:classes dataset) a b)
-                          (data/remove-list (:features dataset) a b))]
-     (dorun (println (str "Data " a " to " b ".")))
+                          (data/remove-list (:features dataset) a b))
+         exp-data {:num (str "Data " a " to " b)
+                   :length-train-cover (select-count #(= % -1) (:classes sample))
+                   :length-test-cover (select-count #(= % -1) (:classes test))
+                   :length-train-stego (select-count #(= % 1) (:classes sample))
+                   :length-test-stego (select-count #(= % 1) (:classes test))}]
      (-> (train-model sample L)
          (#(pmap (fn [feature] (predict % feature)) (:features test)))
          (evaluation (:classes test))
-         (as-> eva (do (println eva)
-                       eva))))))
+         (as-> eva (do [eva exp-data]))))))

 (defn cross-validate
   ([dataset L k]
@@ -142,6 +145,8 @@
          numd (count (:classes norm-dataset)) ; number of data
          groupn (quot numd k)]                ; number of one group's element
      (->> (take k (iterate #(+ % groupn) 0))
-          (pmap #(_cross-validate norm-dataset % (+ % (dec groupn)) L))
+          (pmap #(let [[eva exp-data] (_cross-validate norm-dataset % (+ % (dec groupn)) L)]
+                   (println exp-data)
+                   eva))
           (reduce +)
           (* (/ 1 k))))))


[Add] fun update-exp [Fix] using it in count-rate

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -107,21 +107,17 @@
        (c/sum)
        (sign))))

+(defn update-exp [fn key exp]
+  (reset! exp (assoc @exp key (fn (key @exp))))
+  exp)
+
 (defn count-rate [pred fact exp]
   {:pre [(= (Math/abs pred) (Math/abs fact) 1) (map? @exp)]}
   (cond
-    (and (= pred 1) (= fact 1))
-    (do (reset! exp (assoc @exp :TP (inc (:TP @exp))))
-        exp)
-    (and (= pred 1) (= fact -1))
-    (do (reset! exp (assoc @exp :FP (inc (:FP @exp))))
-        exp)
-    (and (= pred -1) (= fact -1))
-    (do (reset! exp (assoc @exp :TN (inc (:TN @exp))))
-        exp)
-    (and (= pred -1) (= fact 1))
-    (do (reset! exp (assoc @exp :FN (inc (:FN @exp))))
-        exp)))
+    (and (= pred 1) (= fact 1)) (update-exp :TP inc exp)
+    (and (= pred 1) (= fact -1)) (update-exp inc :FP exp)
+    (and (= pred -1) (= fact -1)) (update-exp inc :TN exp)
+    (and (= pred -1) (= fact 1)) (update-exp inc :FN exp)))

 (defn confusion-matrix [preds facts exp]
   {:pre [(coll? preds) (coll? facts) (map? @exp)]}


Fix the mapping function

Fix the mapping function

--- src/cljam/io/wig.clj
+++ src/cljam/io/wig.clj
@@ -58,10 +58,11 @@
 (defn- fields->map
   "Convert vector [\"key1=value1\" \"key2=value2\" ...] to map {:key1 \"value1\" :key2 \"value2\" ...}."
   [fields]
-  (->> fields
-       (map #(cstr/split % #"="))
-       (map (fn [[k v]] [(keyword k) v]))
-       (into {})))
+  (into {}
+        (map (fn [field]
+               (let [[k v] (cstr/split field #"=")]
+                 [(keyword k) v])))
+        fields))

 (defn- str->wiggle-track-data
   "Convert string to Wiggle track data values which can be integer or real,


Allow nil values when filtering against DateTimeFields #1860

--- src/metabase/driver/query_processor/parse.clj
+++ src/metabase/driver/query_processor/parse.clj
@@ -24,5 +24,8 @@
       (instance? RelativeDatetime value)
       (map->RelativeDateTimeValue {:field this, :amount (:amount value), :unit (:unit value)})

+      (nil? value)
+      nil
+
       :else
       (throw (Exception. (format "Invalid value '%s': expected a DateTime." value))))))


#1 support the command to create droplets with ssh_key

--- src/digitalocean_routine/core.clj
+++ src/digitalocean_routine/core.clj
@@ -13,13 +13,16 @@

 (defn- delete-droplets [] "to be implemnted")

-(defn- create-droplets [token number image-id]
+(defn- create-droplets [token number image-id ssh_keys]
   (if (droplets-exist? token)
     (delete-droplets))
-  (for [name (map #(str "rance" %) (range 0 number))]
-    (doall (do/create-droplet token nil {:name name :region "nyc3" :size "1gb" :image image-id}))
-    ))
+  (for [name (map #(str "droplet" %) (range 0 number))]
+    (doall (do/create-droplet token nil {:name name
+                                         :region "nyc3"
+                                         :size "1gb"
+                                         :image image-id
+                                         :ssh_keys [ssh_keys]}))))

 (defn -main [& args]
   (if (= (first args) "create")
-    (create-droplets (nth args 1) (nth args 2) (nth args 3))))
+    (create-droplets (nth args 1) (nth args 2) (nth args 3) (nth args 4))))


Fixed init command error

Fixed init command error

--- src/control/main.clj
+++ src/control/main.clj
@@ -32,10 +32,10 @@
 (defn init
   "Initialize clojure-control, create a sample control file in current directory"
   [ & args]
-  (let [control-file (file "." "control.clj")]
-    (if(.exists control-file)
+  (let [control-file (file (get-control-dir) "control.clj")]
+    (if (.exists control-file)
       (error "File control.clj exists")
-      (spit control-file
+      (do (spit control-file
             (str
              "(defcluster :default-cluster\n"
              "  :clients [\n"
@@ -44,7 +44,8 @@
              "\n"
              "(deftask :date \"echo date on cluster\""
              "  []\n"
-             "  (ssh \"date\"))\n")))))
+             "  (ssh \"date\"))\n"))
+          (println "Create file control.clj.")))))

 (defn show
   "Show cluster info"


Now, let's try with OpenCL 2.0 features (device enqueue etc.).

--- src/clojure/uncomplicate/clojurecl/core.clj
+++ src/clojure/uncomplicate/clojurecl/core.clj
@@ -460,7 +460,7 @@
   (ptr [this]
     "JOCL `Pointer` to this object.")
   (size [this]
-    "Memory size of this cl object in bytes."))
+    "Memory size of this cl or host object in bytes."))

 (defprotocol Contextual
   "An object that has some dependency on a `cl_context`."
@@ -719,10 +719,16 @@
   ([^long size]
    (svm-buffer* *context* size 0 0)))

-(extend-type Number
+(extend-type Long
   Argument
   (set-arg [this kernel n]
-    (with-check (CL/clSetKernelArg kernel n (long this) nil)
+    (with-check (CL/clSetKernelArg kernel n this nil)
+      kernel)))
+
+(extend-type Integer
+  Argument
+  (set-arg [this kernel n]
+    (with-check (CL/clSetKernelArg kernel n this nil)
       kernel)))

 (extend-type (Class/forName "[F")
@@ -1169,12 +1175,12 @@
       (set-args! my-kernel cl-buffer-0)
       (set-args! my-kernel cl-buffer-0 cl-buffer-1 (int-array 8) 42)
       (set-args! my-kernel 2 cl-buffer-2 cl-buffer-3 (int-array 8) 42)
-"
+  "
   ([kernel x & values]
    (if (integer? x)
      (loop [i x values values]
-       (if-let [mem (first values)]
-         (do (set-arg! kernel i mem)
+       (if-let [val (first values)]
+         (do (set-arg! kernel i val)
              (recur (inc i) (next values)))
          kernel))
      (apply set-args! kernel 0 (cons x values)))))
@@ -1388,7 +1394,7 @@
   ([queue cl host blocking offset ^objects wait-events event]
    (with-check
      (CL/clEnqueueReadBuffer queue (cl-mem cl) blocking offset
-                             (size cl) (ptr host)
+                             (min (size cl) (size host)) (ptr host)
                              (if wait-events (alength wait-events) 0)
                              wait-events event)
      queue))
@@ -1438,7 +1444,7 @@
   ([queue cl host blocking offset ^objects wait-events event]
    (with-check
      (CL/clEnqueueWriteBuffer queue (cl-mem cl) blocking offset
-                              (size cl) (ptr host)
+                              (min (size cl) (size host)) (ptr host)
                               (if wait-events (alength wait-events) 0)
                               wait-events event)
      queue))
@@ -1532,7 +1538,7 @@

       (enq-map-buffer* queue cl-data true 0 CL/CL_WRITE (events ev-nd) ev-map)
   "
-  [queue cl blocking offset flags ^objects wait-events event]
+  [queue cl blocking offset flags ^objects wait-events event] ;;TODO size probably overflows!!!!!
   (let [err (int-array 1)
         res (CL/clEnqueueMapBuffer queue (cl-mem cl) blocking flags offset
                                    (size cl)


4clojure:: impl the GCD recursive mode using some HOFs

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -926,6 +926,29 @@
                         [false false] :eq}]
      (lower-compl-map (map #(lower-fn (first %) (second %)) (list ops (reverse ops))))))

+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Write a function which takes a variable number of booleans.
+;; Your function should return true if some of the parameters are true,
+;; but not all of the parameters are true. Otherwise your function should return false
+;; (= false (__ false false))
+;; (= false (__ true))
+;; (= true (__ true false))
+(defn find-half-true
+  [& bools]
+  (let [truthies (filter true? bools)
+        falsies (filter false? bools)]
+    (and (not (empty? truthies)) (not (empty? falsies)))))
+
+;; demo:
+(= false (find-half-true false false))
+(= false (find-half-true true))
+(= true (find-half-true true false))
+
+(doc remove)
+(doc true?)
+(doc if-let)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; create a function which given some numbers will get the greatest common divisor.
 ;; recall that gcd is the common greatest number to which all others are divisible.
@@ -953,14 +976,42 @@
                     possible-divisibles xs))]
        (last (find-gcds smallest-divisibles nums)))))

+;; demo:
 (gcd 3 5 9) ;1
 (gcd 8 12) ;4

+;; tries:
 (seq [1]) ;(1)
 (last [1 2]) ;2
 (last (list 1 2)) ;2

 (defn gcd
   [& nums]
-  (let [divisible? (#(zero? (mod % %2)))
-        ]))
+  (let [divisible? #(zero? (mod % %2))
+        min-num ((comp first sort) nums)
+        min-num-divisibles (filter (partial divisible? min-num) (take min-num (iterate (partial inc) 1)))]
+      (letfn [(find-gcd-rec
+                 [min-nums init-nums]
+                  (if-let [tail-nums (seq init-nums)]
+                    (if (divisible? (first tail-nums) (last min-nums))
+                        (find-gcd-rec min-nums (rest tail-nums))
+                        (find-gcd-rec (butlast min-nums) tail-nums))
+                    (last min-nums)))]
+
+    ;; invoke recursive func
+    (find-gcd-rec min-num-divisibles nums))))
+
+;; demo:
+(gcd 3 5 9) ;1
+(gcd 8 12) ;4
+
+
+;; tries:
+(sort [4 2 5 1 3]) ; (1 2 3 4 5)
+
+;; one way of writing core [iterate fn foo]
+(iterate #(+ 1 %) 1) ; (1 2 3 4 ..) -> f (f (f x))...
+
+;; another way of writing core [iterate] without the literal func, but using partial
+;; that returns the curried back having the curried take one argument.
+(iterate (partial inc) 1) ; (1 2 3 4 ...)


4clojure:: atempt to impl the core [merge-with] first draft

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -2812,3 +2812,64 @@
                    #(foo x (+ 2 y))))]
      (trampoline foo [] 1)))
 ;; what's the result?
+
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Merge with a Function
+;;
+;; Difficulty:	Medium
+;; Topics:	core-functions
+;; Special Restrictions: [merge-with]
+;; Write a function which takes a func and a varargs maps, using the function it merges the existing values
+;; in the first map, from the rest of maps
+;; = (__ * {:a 2, :b 3, :c 4} {:a 2} {:b 2} {:c 5})
+;;    ->  {:a 4, :b 6, :c 20})
+(defn merge-maps-with
+  [func & [head secnd & tail]]
+  (letfn [(merge-one
+             [func x-map y-map]
+             (reduce
+                (fn [acc entry]
+                  (if (get y-map (first entry))
+                    (assoc acc (first entry) (func (second entry) (get y-map (first entry))))
+                    (assoc acc (first entry) (second entry))))
+                {} x-map))]
+  (if (nil? secnd)
+    head
+    (recur func (cons (merge-one func head secnd) tail)))))
+
+(merge-maps-with * {:a 2, :b 3, :c 4} {:a 2} {:b 2} {:c 5})  ;; {:c 20 :b 6 :a 4}
+;; -> OK if the first map is the biggest map -> else:
+(merge-maps-with - {1 10, 2 20} {1 3, 2 10, 3 15}) ;; {2 10, 1 7} --> the [3 15] entry is lost
+
+;; -> find a way to use inside the [reduce] as the sequential the most big map, leaving the checker the
+;; smallest one, since if the checker does tno have the entry -> use the one from the sequential map
+
+;; -> to fix this:
+(defn merge-maps-with
+  [func & [head secnd & tail]]
+  (letfn [(merge-one
+             [func x-map y-map]
+             (if (< (count x-map) (count y-map))
+               (recur func y-map x-map)
+               (reduce
+                (fn [acc entry]
+                  (if-let [found-val (get y-map (first entry))]
+                    (assoc acc (first entry) (func (second entry) found-val))
+                    (conj acc entry)))
+                {} x-map)))]
+  (if (nil? secnd)
+    head
+    (recur func (cons (merge-one func head secnd) tail)))))
+
+(merge-maps-with - {1 10, 2 20} {1 3, 2 10, 3 15}) ;; {3 15, 2 10, 1 7}
+
+;; this solves temporarily the problem: the recur and switching the maps for handling associative operations
+;; but having this case:
+(merge-maps-with concat {:a [3], :b [6]} {:a [4 5], :c [8 9]} {:b [7]} {:z [20]})
+;; -> correct result: {:a [3 4 5], :b [6 7], :c [8 9]}
+(reduce #(assoc % (second %2) (first %2)) {} (seq {:a 1 :b 2}))
+(conj {1 2} {3 4})
+
+(dissoc {1 2 3 4} 1)
+(- 10 3 8) ;; -1


Add auth to the persistente vector.

Add auth to the persistente vector.

With minor mostly cosmetic changes in the ns.

--- src/uxbox/core.cljs
+++ src/uxbox/core.cljs
@@ -10,12 +10,16 @@

 (enable-console-print!)

+(def ^:const ^:private +persistent-keys+
+  [:auth
+   :pages-by-id
+   :shapes-by-id
+   :colors-by-id
+   :projects-by-id])
+
 (defn- main
   []
-  (let [lens (l/select-keys [:pages-by-id
-                             :shapes-by-id
-                             :colors-by-id
-                             :projects-by-id])
+  (let [lens (l/select-keys +persistent-keys+)
         stream (->> (l/focus-atom lens st/state)
                     (rx/from-atom)
                     (rx/dedupe)


CMR-5104: Updated REPL setup.

CMR-5104: Updated REPL setup.


typo in comment

typo in comment

--- test/re_frame/fx_test.cljs
+++ test/re_frame/fx_test.cljs
@@ -23,7 +23,7 @@

 (deftest dispatch-later
   (let [seen-events (atom [])]
-    ;; Setup and excercise effects handler with :dispatch-later.
+    ;; Setup and exercise effects handler with :dispatch-later.
     (re-frame/reg-event-fx
       ::later-test
       (fn [_world _event-v]


more testing

more testing

--- test/shuppet/unit/core.clj
+++ test/shuppet/unit/core.clj
@@ -2,6 +2,7 @@
   (:require  [slingshot.slingshot :refer [try+ throw+]]
              [cluppet.core :as cluppet]
              [shuppet.sqs :as sqs]
+             [shuppet.util :as util]
              [shuppet.git :as git])
   (:use [shuppet.core]
         [midje.util]
@@ -39,4 +40,23 @@
                    => ..str-app..
                    (cluppet/evaluate-string [..str-env.. ..str-app..] anything)
                    =>  {:Role {:RoleName ..name..
-                               :Policies [..app-policy..]}})))
+                               :Policies [..app-policy..]}}))
+
+            (fact "env and all apps are configured"
+                  (configure-apps ..env..) => [..report..]
+                  (provided
+                   (apply-config ..env..) => []
+                   (git/get-data ..env..) => ..env-config..
+                   (filtered-apply-config ..env-config.. ..env.. ..app..) => ..report..
+                   (app-names ..env..) => [..app..]))
+
+            (fact "error is caught and added to report"
+                  (apply-config ..env-config.. ..env.. ..app..) => (contains {:app ..app..
+                                                                              :env ..env..
+                                                                              :message anything
+                                                                              :stacktrace anything})
+                  (provided
+                   (get-config ..env-config.. ..env.. ..app..) => ..app-config..
+                   (cluppet/apply-config ..app-config.. ) =throws=>  (NullPointerException.)))
+
+            (future-fact "env error are caught"))


Näytä aina yhtä iso sivutin

Näytä aina yhtä iso sivutin

--- mtg-pairings-server/src/cljs/mtg_pairings_server/components/paging.cljs
+++ mtg-pairings-server/src/cljs/mtg_pairings_server/components/paging.cljs
@@ -10,14 +10,14 @@
    (inc num)])

 (defn pager [page-atom num-pages]
-  (let [shown-pages (concat [nil]
-                            (when (pos? @page-atom) [0])
-                            (when (= @page-atom 3) [1])
-                            (when (> @page-atom 1) [(dec @page-atom)])
-                            [@page-atom]
-                            (when (< @page-atom (- num-pages 2)) [(inc @page-atom)])
-                            (when (= @page-atom (- num-pages 4)) [(- num-pages 2)])
-                            (when (< @page-atom (dec num-pages)) [(dec num-pages)]))]
+  (let [shown-pages (if (<= num-pages 7)
+                      (range 0 num-pages)
+                      (concat [0]
+                              (cond
+                                (<= @page-atom 3) (range 1 5)
+                                (<= (- num-pages @page-atom) 4) (range (- num-pages 5) (dec num-pages))
+                                :else [(dec @page-atom) @page-atom (inc @page-atom)])
+                              [(dec num-pages)]))]
     [:div.pager
      (if (pos? @page-atom)
        [:div.button.prev-page {:on-click #(swap! page-atom dec)} "<"]
@@ -26,7 +26,7 @@
                [(when (and (some? prev) (> (- cur prev) 1))
                   [:div.button.separator.disabled "···"])
                 [page-button page-atom cur]])
-             (partition 2 1 shown-pages))
+             (partition 2 1 (cons nil shown-pages)))
      (if (< @page-atom (dec num-pages))
        [:div.button.next-page {:on-click #(swap! page-atom inc)} ">"]
        [:div.button.next-page.disabled ">"])]))


stop logging certain repeated calls

stop logging certain repeated calls

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -15,7 +15,7 @@
 ;               INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES.

 (ns org.micromanager.sequence-generator
-  (:use [org.micromanager.mm :only [select-values-match? core]]))
+  (:use [org.micromanager.mm :only [select-values-match? core mmc]]))

 (def MAX-Z-TRIGGER-DIST 5.0)

@@ -150,9 +150,9 @@
     (and
       (channels-sequenceable (make-property-sequences props) channels)
       (or (= (e1 :slice) (e2 :slice))
-          (let [z-drive (core getFocusDevice)]
+          (let [z-drive (. mmc getFocusDevice)]
             (and
-              (core isStageSequenceable z-drive)
+              (. mmc isStageSequenceable z-drive)
               (< n (core getStageSequenceMaxLength z-drive))
               (<= (Math/abs (- (e1 :slice) (e2 :slice))) MAX-Z-TRIGGER-DIST)
               (<= (e1 :slice-index) (e2 :slice-index))))))))


Don't delete event if we don't add exposure.

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -59,7 +59,8 @@

 (defn assign-exposure [event]
   (if (:channel event)
-    (assoc event :exposure (get-in event [:channel :exposure]))))
+    (assoc event :exposure (get-in event [:channel :exposure]))
+    event))

 (defn process-skip-z-stack [events slices]
   (if (pos? (count slices))
@@ -134,7 +135,7 @@
   (let [{:keys [slices keep-shutter-open-channels keep-shutter-open-slices
          use-autofocus autofocus-skip interval-ms]} settings]
     (-> (make-main-loops settings)
-      ;(#(map (comp assign-z-drive assign-exposure) %))
+      (#(map (comp assign-exposure assign-z-drive) %))
       (process-skip-z-stack slices)
       (manage-shutter keep-shutter-open-channels keep-shutter-open-slices)
       (process-channel-skip-frames)


Only update metadata if the dates are different.

--- src/kixi/hecuba/data/validate.clj
+++ src/kixi/hecuba/data/validate.clj
@@ -56,8 +56,9 @@
    (.before min-date lower_ts) {:lower_ts min-date}
    (.after max-date upper_ts) {:upper_ts max-date}))

-(defn columns-to-update [sensor start end new-bounds]
-  (log/debugf "Sensor: %s Start: %s End: %s New-bounds: %s" sensor start end new-bounds)
+(defn columns-to-update?
+  "It returns columns to update, if there are any. Otherwise it returns nil."
+  [sensor start end new-bounds]
   (merge
    (when-let [rollups (update-date-range sensor :rollups start end)]
      {:rollups [+ rollups]})
@@ -84,7 +85,8 @@
           end        (tc/to-date max-date)
           new-bounds (update-bounds start end sensor)
           where      (m/where-from sensor)]
-      (db/execute session
-                  (hayt/update :sensor_metadata
-                               (hayt/set-columns (columns-to-update sensor start end new-bounds))
-                               (hayt/where where))))))
+      (when-let [columns (columns-to-update? sensor start end new-bounds)]
+        (db/execute session
+                    (hayt/update :sensor_metadata
+                                 (hayt/set-columns columns)
+                                 (hayt/where where)))))))


Change order of args in generate-card, added functionality for version comparison options

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -31,13 +31,24 @@

 (def
   ^:private
+  version-comparators
+  {
+   "debian" vers/debian-vercmp
+   "maven" vers/debian-vercmp
+   "naive" vers/naive-vercmp
+   "python" vers/python-vercmp
+   "rpm" vers/rpm-vercmp
+   "rubygem" vers/rubygem-vercmp
+   "semver" vers/semver-vercmp
+   })
+
+(def
+  ^:private
   package-systems
   {"apt" {:genrepo apt-pkg/slurp-apt-repo
-             :vercmp vers/debian-vercmp}
+             :version-comparison "debian"}
    "degasolv" {:genrepo degasolv-pkg/slurp-degasolv-repo
-               :vercmp vers/maven-vercmp}})
-
-
+               :version-comparison "maven"}})

 (defn- generate-repo-index-cli!
   [options arguments]
@@ -56,16 +67,15 @@

 (defn- aggregate-repositories
   [index-strat
-   pkgsys
-   repositories]
-
+   repositories
+   genrepo
+   cmp]
   ((aggregator index-strat
-               (get-in package-systems [pkgsys :vercmp]))
+               cmp)
    (flatten
     (map
        (fn [url]
-         ((get-in package-systems [pkgsys :genrepo]) url)
-         )
+         (genrepo url))
        repositories))))

 (defn-
@@ -86,8 +96,11 @@
                search-strat
                present-packages
                requirements
-               package-system]}
+               package-system
+               version-comparison]}
        options
+       version-comparator
+       (get version-comparators version-comparison)
        requirement-data
        (into []
              (map
@@ -105,13 +118,12 @@
                    (string-to-requirement vetted-str-req)))
                requirements))
        present-packages
-       (t/spy :msg "present-packages"
-              (reduce
-               (fn package-aggregate
-                 [c [name pkg]]
-                 (update-in c [name]
-                    conj
-                    pkg))
+       (reduce
+        (fn package-aggregate
+          [c [name pkg]]
+          (update-in c [name]
+                     conj
+                     pkg))
         {}
         (map
          (fn [str-pkg]
@@ -136,8 +148,9 @@
        aggregate-repo
        (aggregate-repositories
          index-strat
-         package-system
-         repositories)
+         repositories
+         (get-in package-systems [pkgsys :genrepo])
+         version-comparator)
        result
        (resolve-dependencies
         requirement-data
@@ -146,7 +159,7 @@
         :strategy (keyword resolve-strat)
         :conflict-strat (keyword conflict-strat)
         :search-strat (keyword search-strat)
-        :compare (get-in package-systems [package-system :vercmp])
+        :compare version-comparator
         :allow-alternatives alternatives)]
     (case
       (first result)
@@ -177,7 +190,7 @@
   (default-spit
    card-file
    (->PackageInfo
-    id
+    idt
     version
     location
     (into []
@@ -187,17 +200,24 @@

 (defn query-repo!
   [options arguments]
-  (let [{:keys [repositories query index-strat package-system]} options
+  (let [{:keys [repositories
+                query
+                index-strat
+                package-system
+                version-comparison]}
+        options
+        version-comparator
+        (get version-comparators version-comparison)
         aggregate-repo
         (aggregate-repositories
-          index-strat
-          package-system
-          repositories)
+         index-strat
+         repositories
+         (get-in package-systems [pkgsys :genrepo])
+         version-comparator)
         req (first (string-to-requirement query))
         {:keys [id spec]} req
         spec-call (make-spec-call
-                   (get-in package-systems
-                           [package-system :vercmp]))
+                   version-comparator)
         results (filter
                  #(spec-call spec %)
                  (aggregate-repo id))]
@@ -235,15 +255,16 @@
     :required-arguments {:id ["-i" "--id"]
                          :version ["-v" "--version"]
                          :location ["-l" "--location"]}
-    :cli [["-i" "--id ID"
+    :cli [
+          ["-C" "--card-file FILE"
+           (str "The name of the card file")
+
+           :validate [#(not (empty? %))
+                      "Out file must not be empty."]]
+          ["-i" "--id ID"
            "ID (name) of the package"
            :validate [#(not (empty? %))
                       "ID must be a non-empty string."]
-           :required true]
-          ["-v" "--version VERSION"
-           "Version of the package"
-           :validate [#(re-matches r/version-regex %)
-                      "Sorry, given argument doesn't look like a version."]
            :required true]
           ["-l" "--location LOCATION"
            "URL or filepath of the package"
@@ -257,11 +278,12 @@
            :id :requirements
            :assoc-fn
            (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-C" "--card-file FILE"
-           (str "The name of the card file")
-
-           :validate [#(not (empty? %))
-                      "Out file must not be empty."]]]}
+          ["-v" "--version VERSION"
+           "Version of the package"
+           :validate [#(re-matches r/version-regex %)
+                      "Sorry, given argument doesn't look like a version."]
+           :required true]
+          ]}
    "generate-repo-index"
    {:description "Generate repository index based on degasolv package cards"
     :function generate-repo-index-cli!
@@ -329,13 +351,18 @@
            "May be 'degasolv' or 'apt'."
            :validate [#(or (= "degasolv" %) (= "apt" %))
                       "Package system must be either 'degasolv' or 'apt'."]]
+          ["-V" "--version-comparison CMP"
+           "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
+           :validate [#(some #{%} (keys version-comparators))
+                      "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
           ]}
    "query-repo"
    {:description "Query repository for a particular package"
     :function query-repo!
     :required-arguments {:repositories ["-R" "--repository"]
                          :query ["-q" "--query"]}
-    :cli [["-q" "--query QUERY"
+    :cli [
+          ["-q" "--query QUERY"
            "Display packages matching query string."
            :validate [#(and (re-matches r/str-requirement-regex %)
                             (let [strreq (string-to-requirement %)]
@@ -354,7 +381,15 @@
           ["-t" "--package-system SYS"
            "May be 'degasolv' or 'apt'."
            :validate [#(or (= "degasolv" %) (= "apt" %))
-                      "Package system must be either 'degasolv' or 'apt'."]]]}})
+                      "Package system must be either 'degasolv' or 'apt'."]]
+          ["-V" "--version-comparison CMP"
+           "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
+           :validate [#(some #{%} (keys version-comparators))
+                      "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
+          ]
+    }
+   }
+  )

 (defn command-list [commands]
   (->> ["Commands are:"
@@ -594,7 +629,14 @@
                (conj it (dissoc config :option-packs))
                (conj it options)
                (reduce merge (hash-map) it)
-               )
+               (if (not (:version-comparison it))
+                 (assoc
+                  it
+                  :version-comparison
+                  (as-> (:package-system it) x
+                    (get package-systems x)
+                    (get x :version-comparison)))
+                 it))
               required-keys (set (keys (:required-arguments subcmd-cli)))
               present-keys (set (keys effective-options))]
           (when (not (st/subset? required-keys present-keys))


fixed previous bug

fixed previous bug

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -271,7 +271,7 @@
                              (is-cycle-change?))
         day-ranges (-> cycle-posts
                        (keys)
-                       (#(if ((or (and (= cycle-type :day) (= first-cycle-type :day)) (and (= cycle-type :night) (= first-cycle-type :night)))
+                       (#(if (or (and (= cycle-type :day) (= first-cycle-type :day)) (and (= cycle-type :night) (= first-cycle-type :night)))
                            (cons (dec first-index) %)
                            %))
                        (to-day-ranges))


Use simple token instead of token for frontend

--- src-cljs/photon/ui/frontend.cljs
+++ src-cljs/photon/ui/frontend.cljs
@@ -798,7 +798,7 @@
             fn-clk (fn [_]
                      (go (let [res (<! (fn-post))]
                            (upd :auth res)
-                           (ck/set "token" (:token (:body res))))))]
+                           (ck/set "token" (:simple-token (:body res))))))]
         (if (= 200 (:status (:auth state)))
           (set! (.-location js/window) "/ui")
           (dom/div nil


[#1450] Use different types of generated data

--- backend/test/akvo/lumen/lib/transformation_test.clj
+++ backend/test/akvo/lumen/lib/transformation_test.clj
@@ -435,7 +435,7 @@
   (let [dataset-id (import-file *tenant-conn* *error-tracker*
                                        {:dataset-name "origin-dataset"
                                         :kind "clj"
-                                        :data (i-c/sample-imported-dataset [:text :number :number :text] 2)})
+                                        :data (i-c/sample-imported-dataset [:text :number :number :date :multiple] 2)})
         apply-transformation (partial tf/apply {:tenant-conn *tenant-conn*} dataset-id)]
     (let [[tag _] (apply-transformation {:type :transformation
                                          :transformation {"op" "core/delete-column"
@@ -444,7 +444,7 @@
       (is (= ::lib/ok tag))
       (let [{:keys [columns transformations]} (latest-dataset-version-by-dataset-id *tenant-conn*
                                                                                {:dataset-id dataset-id})]
-        (is (= ["c1" "c3" "c4"] (map #(get % "columnName") columns)))
+        (is (= ["c1" "c3" "c4" "c5"] (map #(get % "columnName") columns)))
         (let [{:strs [before after]} (get-in (last transformations) ["changedColumns" "c2"])]
           (is (= "c2" (get before "columnName")))
           (is (nil? after)))))))
@@ -493,7 +493,7 @@
       (assoc :rows (map #(assoc-in % [column-idx] (nth %2 column-idx)) (:rows target-data) (:rows origin-data)))))

 (deftest ^:functional merge-datasets-test
-  (let [origin-data (i-c/sample-imported-dataset [:text :number] 2)
+  (let [origin-data (i-c/sample-imported-dataset [:text :date] 2)
         target-data (replace-column origin-data (i-c/sample-imported-dataset [:text :number :number :text] 2) 0)
         origin-dataset-id (import-file *tenant-conn* *error-tracker*
                                        {:dataset-name "origin-dataset"


Fix colorpalette rendering.

Fix colorpalette rendering.

--- src/uxbox/main/ui/workspace/colorpalette.cljs
+++ src/uxbox/main/ui/workspace/colorpalette.cljs
@@ -51,7 +51,9 @@
   {:mixins [mx/static mx/reactive (mx/local)]}
   [own]
   (let [local (:rum/local own)
-        collections (sort-by :name (mx/react collections-ref))
+        collections (->> (mx/react collections-ref)
+                         (vals)
+                         (sort-by :name))
         collection (get-selected-collection local collections)]
     (letfn [(select-collection [event]
               (let [value (read-string (dom/event->value event))]
@@ -64,12 +66,12 @@
          (for [collection collections]
            [:option {:key (str (:id collection))
                      :value (pr-str (:id collection))}
-            (:name collection)])]
+            (:name collection "Storage")])]
         #_[:div.color-palette-buttons
            [:div.btn-palette.edit.current i/pencil]
            [:div.btn-palette.create i/close]]]
        [:span.left-arrow i/arrow-slide]
-       (palette-items (:data collection))
+       (palette-items (:colors collection))
        [:span.right-arrow i/arrow-slide]
        [:span.close-palette {:on-click close}
         i/close]])))


add sprint-notes api function

add sprint-notes api function

--- src/strictly_specking/annotated_pprint.clj
+++ src/strictly_specking/annotated_pprint.clj
@@ -256,6 +256,10 @@
 (defn annotate-paths [data path-to-annotation-map]
   (reduce #(annotate-path %1 (first %2) (second %2))
           data path-to-annotation-map))
+
+(defn pprint-notes [annotated-data]
+  (pp/with-pprint-dispatch error-path-dispatch
+      (pp/pprint annotated-data)))

 #_(ansi-util/with-ansi-when true
     (pp/with-pprint-dispatch error-path-dispatch