Refactors save, rename, remove

Refactors save, rename, remove

--- src/wordsmith/core.cljs
+++ src/wordsmith/core.cljs
@@ -38,10 +38,7 @@

 (defn handle-title-blur [event app]
   (let [new-title (.. event -target -value)]
-    (p/set-document new-title (:input @app))
-    (p/remove-document (:last-title @app))
-    (om/update! app :last-title new-title)
-    (om/update! app :titles (p/get-all-titles))))
+    (put! (:channel @app) [:rename new-title])))

 (defn title-field [app owner]
   (reify
@@ -62,8 +59,7 @@
     (om/update! app :last-title title)))

 (defn delete-click [title app]
-  (p/remove-document title)
-  (om/update! app :titles (p/get-all-titles)))
+  (put! (:channel @app) [:remove title]))

 (defn left-menu [app owner]
   (reify
@@ -97,11 +93,31 @@

 ;; The main app

+  ; (p/rename-document (:last-title @app) new-title)
+  ; (om/update! app :last-title new-title)
+  ; (om/update! app :titles (p/get-all-titles)
+
+(defn rename-document [app new-title]
+  (p/rename-document (:last-title @app) new-title)
+  (save-document app)
+  (om/update! app :last-title new-title)
+  (om/update! app :titles (p/get-all-titles)))
+
 (defn save-document [app]
   (om/update! app :last-saved (js/Date.))
   (om/update! app :last-title (:title @app))
   (p/set-document (:title @app) (:input @app))
   (om/update! app :titles (p/get-all-titles)))
+
+(defn remove-document [app title]
+  (p/remove-document title)
+  (om/update! app :titles (p/get-all-titles)))
+
+(defn dispatch [command params app]
+  (case command
+    :save   (save-document app)
+    :rename (rename-document app params)
+    :remove (remove-document app params)))

 (defn listen [el type app]
   (events/listen el type
@@ -118,8 +134,8 @@
       (om/update! app :titles (p/get-all-titles))
       (let [channel (:channel app)]
         (go-loop []
-          (let [[action params] (<! channel)]
-            (save-document app)
+          (let [[command params] (<! channel)]
+            (dispatch command params app)
             (recur))))
       (listen js/document EventType/KEYDOWN app))
     om/IRender


Fix hyperlinks conditions

Fix hyperlinks conditions

--- src/cljs/salava/social/ui/badge_message.cljs
+++ src/cljs/salava/social/ui/badge_message.cljs
@@ -111,9 +111,9 @@
       [:span.date (date-from-unix-time (* 1000 ctime) "minutes")]
      ]
     (into [:div] (for [ item (clojure.string/split-lines message)]
-                   (into [:p.msg] (if (or (re-find #"www." item) (re-find #"^https?://" item) (re-find #"^http?://" item))
-                                    (search-and-replace-www item)
-                                    item))))]])
+                   (into [:p.msg] (if (or (re-find #"www." item) (re-find #"https?://" item) (re-find #"http?://" item))
+                                      (search-and-replace-www item)
+                                      item))))]])

 (defn message-list-load-more [state]
   (if (pos? (:messages_left @state))


Fix jump to source, close #3

Fix jump to source, close #3

This fixes jump to source for jar files in clojure and clojurescript.
This also fixes jumping to src-paths in clj e.g. lighttable/nrepl/eval.clj.

--- lein-light-nrepl/src/lighttable/nrepl/doc.clj
+++ lein-light-nrepl/src/lighttable/nrepl/doc.clj
@@ -2,9 +2,12 @@
   (:require [lighttable.nrepl.core :as core]
             [lighttable.nrepl.eval :as eval]
             [lighttable.nrepl.cljs :as cljs]
+            [clojure.java.io :as io]
+            [clojure.string :as string]
             [cljs.env :as env]
             [cljs.compiler :as comp]
-            [cljs.analyzer :as ana]))
+            [cljs.analyzer :as ana])
+  (:import java.net.URL java.io.File))

 (defn clean-meta [m]
   (when m
@@ -42,6 +45,37 @@
                              (str-contains? (str (:name m)) search)))]
                (format-result (clean-meta m)))))

+(def jar-temp-files
+  "Maps jar-url paths to temp files"
+  (atom {}))
+
+(defn jar-url->file
+  "Given a jar-url, retrieve its cached tempfile or copy its contents to a
+  tempfile and return it."
+  [^URL jar-url]
+  (or
+   (get @jar-temp-files (.getPath jar-url))
+   (let [[_ relative-name ext] (re-find #"!/(.*)(\.[^.]+)$" (.getPath jar-url))
+         new-file (.getPath (File/createTempFile relative-name ext))
+         body (-> jar-url .getContent slurp)]
+     (swap! jar-temp-files assoc (.getPath jar-url) new-file)
+     (spit new-file body)
+     new-file)))
+
+(defn resolve-file
+  "Resolves a file to its full path. Jar paths are unpacked to a tempfile."
+  [file]
+  (when file
+    (let [url (or (io/resource file)
+                  (URL.
+                   ;; cljs files don't have jar:file: or file: prefix off of metadata
+                   (if (.contains file ".jar!/")
+                     (string/replace-first file #"^file:" "jar:file:")
+                     (string/replace-first file #"^/" "file:/"))))]
+      (if (= "jar" (.getProtocol url))
+        (jar-url->file url)
+        (-> url io/file .getPath)))))
+
 (defn dmeta [nsp sym]
   (-> (ns-resolve (symbol nsp) sym)
       (meta)
@@ -77,8 +111,9 @@
 (defmethod core/handle "editor.clj.doc" [{:keys [ns sym loc session path result-type] :as msg}]
   (let [ns (eval/normalize-ns ns path)
         _ (eval/require|create-ns (symbol ns))
-        res (get-doc ns sym)
-        res (when res (assoc res :loc loc :result-type result-type))]
+        res (some-> (get-doc ns sym)
+                    (assoc :loc loc :result-type result-type)
+                    (update-in [:file] resolve-file))]
     (core/respond msg "editor.clj.doc" res))
   @session)

@@ -91,7 +126,9 @@
                                  res (if (:macro clj)
                                        clj
                                        (get-cljs-doc ns sym))
-                                 res (when res (assoc res :loc loc :result-type result-type))]
+                                 res (some-> res
+                                             (assoc :loc loc :result-type result-type)
+                                             (update-in [:file] resolve-file))]
                              (core/respond msg "editor.cljs.doc" res))))
   @session)


log loading of connectors on debug level instead of info to reduce noise from the new self-refreshing service configuration

--- db-serializers/src/com/sixsq/slipstream/db/serializers/service_config_impl.clj
+++ db-serializers/src/com/sixsq/slipstream/db/serializers/service_config_impl.clj
@@ -466,9 +466,9 @@
   This is done for the compatibility with the current logic of the service."
   [^Object sc]
   (let [cin-cn (sc-connector-names-map sc)]
-    (log/info "Loading connectors" cin-cn)
+    (log/debug "Loading connectors" cin-cn)
     (doseq [[cin cn] cin-cn]
-      (log/info "Loading connector" cin cn)
+      (log/debug "Loading connector" cin cn)
       (let [values (strip-unwanted-attrs (:body (con/retrieve-impl (connector-as-request cin))))
             _ (log/debug "Connector values:" values)
             descs (get @cont/descriptions (str cont/resource-url "/" cn))]


Added license text into core_test.clj

Added license text into core_test.clj

--- test/arachnida/core_test.clj
+++ test/arachnida/core_test.clj
@@ -1,3 +1,15 @@
+;
+;  (C) Copyright 2015  Pavel Tisnovsky
+;
+;  All rights reserved. This program and the accompanying materials
+;  are made available under the terms of the Eclipse Public License v1.0
+;  which accompanies this distribution, and is available at
+;  http://www.eclipse.org/legal/epl-v10.html
+;
+;  Contributors:
+;      Pavel Tisnovsky
+;
+
 (ns arachnida.core-test
   (:require [clojure.test :refer :all]
             [arachnida.core :refer :all]))


Add lein-ancient

Add lein-ancient

--- lein/profiles.clj
+++ lein/profiles.clj
@@ -1,4 +1,9 @@
 {
+ :user {
+        :plugins [
+                  [lein-ancient "0.5.5"]
+                  ]
+        }
  :dev {
         :dependencies [[clj-stacktrace "0.2.8"]]
         :injections [(require 'clj-stacktrace.repl)]


Tweak the commented eager-loading test. Soon.

--- clj_record/test/associations_test.clj
+++ clj_record/test/associations_test.clj
@@ -32,7 +32,7 @@
         manu2 (manufacturer/create {:name "manu2" :grade 99})
         prod3 (product/create {:name "prod3" :manufacturer_id (:id manu2)})
         prod4 (product/create {:name "prod4" :manufacturer_id (:id manu2)})]
-    (let [[eager-manu1 eager-manu2] (manufacturer/find-records {:grade 99} {:include "products"})]
+    (let [[eager-manu1 eager-manu2] (manufacturer/find-records {:grade 99} {:include [:products]})]
       (are (= _1 _2)
         "manu1" (:name eager-manu1)
         "manu2" (:name eager-manu2)


Improve function and variable names

Improve function and variable names

--- src/javascript_externs_generator/extern.cljs
+++ src/javascript_externs_generator/extern.cljs
@@ -3,7 +3,7 @@
             [goog.object :as obj]
             [clojure.string :as string]))

-(defn get-type
+(defn prop-type
   "Differentiate between function property and object property"
   [obj]
   (if (fn? obj)
@@ -16,57 +16,57 @@
   (or (= (goog/typeOf obj) "object")
       (fn? obj)))

-(defn build-tree
+(defn generate-object-tree
   "Build a recursive tree representation of the JavaScript object
   and metadata about its properties, prototype, and functions"
   [obj name]
   {:name      name
-   :type      (get-type obj)
-   :props     (for [k (js-keys obj)
-                    :let [child (obj/get obj k)]]
+   :type      (prop-type obj)
+   :props     (for [prop-name (js-keys obj)
+                    :let [child (obj/get obj prop-name)]]
                 (if (and (parent-type? child)
                          (not (identical? obj child)))
-                  (build-tree child k)
-                  {:name k :type (get-type child)}))
-   :prototype (for [k (js-keys (.-prototype obj))]
-                {:name k :type :function})})
+                  (generate-object-tree child prop-name)
+                  {:name prop-name :type (prop-type child)}))
+   :prototype (for [prop-name (js-keys (.-prototype obj))]
+                {:name prop-name :type :function})})

-(defn build-props-extern
+(defn emit-props-extern
   "Return recursive string representation of an object's properties"
   [obj]
   (let [{:keys [name type props]} obj
         function-str (if (and (= type :function)
                               (empty? props)) "function()" "")
         props-extern (str "{" (string/join "," (for [p props]
-                                                 (build-props-extern p))) "}")]
+                                                 (emit-props-extern p))) "}")]
     (if (get obj :root)
       (str "var " name " = " function-str props-extern ";")
       (str (quote-string name) ": " function-str props-extern))))

-(defn build-prototype
+(defn emit-prototype
   "Return string representation of an object's prototype/functions"
   [namespace prototype]
   (when (seq prototype)
     (str namespace ".prototype = {" (string/join "," (for [p prototype]
                                                        (str (quote-string (:name p)) ": function(){}"))) "};")))

-(defn build-prototype-extern
+(defn emit-prototype-extern
   "Return recursive string representation of an object's prototype chain"
   [obj namespace]
   (let [{:keys [name props prototype]} obj
-        prototype-extern (build-prototype namespace prototype)
+        prototype-extern (emit-prototype namespace prototype)
         child-prototype-externs (for [p props]
-                                  (build-prototype-extern p (str namespace "." (:name p))))]
+                                  (emit-prototype-extern p (str namespace "." (:name p))))]
     (str prototype-extern (string/join child-prototype-externs))))

 (defn extract
   "Recursively extract properties and prototypes from a JavaScript object
   into an extern for use with the Google Closure Compiler"
   [name js-object]
-  (let [tree (assoc (build-tree js-object name) :root true)
-        props-extern (build-props-extern tree)
-        prototype-extern (build-prototype-extern tree name)]
+  (let [tree (assoc (generate-object-tree js-object name) :root true)
+        props-extern (emit-props-extern tree)
+        prototype-extern (emit-prototype-extern tree name)]
     (str props-extern prototype-extern)))

 (defn extract-loaded


Making 'smart' build notifications option more understandable.

--- src-cljs/frontend/components/project/common.cljs
+++ src-cljs/frontend/components/project/common.cljs
@@ -116,7 +116,7 @@
 (def email-prefs
   [["default" "Default"]
    ["all" "All builds"]
-   ["smart" "My breaks and fixes"]
+   ["smart" "Branches I've pushed to"]
    ["none" "None"]])

 (defn email-pref [{:keys [project user]} owner]


Factor out some stuff

Factor out some stuff

--- test/icecap/e2e/http_test.clj
+++ test/icecap/e2e/http_test.clj
@@ -39,9 +39,10 @@
 (use-fixtures :each store-reqs-fixture)

 (deftest http-tests
-  (let [create-result @(create-cap {:type :http
-                                    :url (str http-server-base-url
-                                              "/test/example")})
+  (let [plan {:type :http
+              :method :GET
+              :url (str http-server-base-url "/test/example")}
+        create-result (spy @(create-cap plan))
         cap-url (:cap (get-body create-result))
         exercise-result @(execute-cap cap-url)]
     (is (= (select-keys create-result [:code])


Fixes Validation test.

Fixes Validation test.

--- test/onyx/validation_test.clj
+++ test/onyx/validation_test.clj
@@ -166,60 +166,59 @@

         correct-workflow [[:in :intermediate] [:intermediate :out]]]
     (testing "bad-jobs-1"
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog illegal-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog illegal-input-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog illegal-output-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog illegal-function-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog illegal-dispatch-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog incomplete-catalog :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog bad-fn-ns-form :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog bad-input-plugin :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog bad-output-plugin :workflow workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced}))))
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog illegal-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog illegal-input-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog illegal-output-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog illegal-function-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog illegal-dispatch-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog incomplete-catalog :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog bad-fn-ns-form :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog bad-input-plugin :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog bad-output-plugin :workflow workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced})))))

     (testing "bad-jobs-2"
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
-                                                               :workflow illegal-incoming-inputs-workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
-                                                               :workflow illegal-outgoing-outputs-workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
-                                                               :workflow illegal-edge-nodes-count-workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
-                                                               :workflow illegal-intermediate-nodes-workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced})))
-
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
-                                                               :workflow dupes-workflow
-                                                               :task-scheduler :onyx.task-scheduler/balanced}))))
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
+                                                            :workflow illegal-incoming-inputs-workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
+                                                            :workflow illegal-outgoing-outputs-workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
+                                                            :workflow illegal-edge-nodes-count-workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
+                                                            :workflow illegal-intermediate-nodes-workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced}))))
+
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog workflow-tests-catalog
+                                                            :workflow dupes-workflow
+                                                            :task-scheduler :onyx.task-scheduler/balanced})))))

     (testing "bad-jobs-3"
-      (is (thrown? Exception (onyx.api/submit-job peer-config {:catalog correct-catalog
-                                                               :workflow correct-workflow
-                                                               :lifecycles invalid-lifecycles
-                                                               :task-scheduler :onyx.task-scheduler/balanced}))))))
-
+      (is (not (:success? (onyx.api/submit-job peer-config {:catalog correct-catalog
+                                                            :workflow correct-workflow
+                                                            :lifecycles invalid-lifecycles
+                                                            :task-scheduler :onyx.task-scheduler/balanced})))))))

 (deftest map-set-workflow
   (is (= (sort [[:a :b]


Bumped lein-lambda-blog version to 0.1.0.

--- lein-lambda-blog/project.clj
+++ lein-lambda-blog/project.clj
@@ -1,4 +1,4 @@
-(defproject lambda-blog/lein-template "0.1.0-SNAPSHOT"
+(defproject lambda-blog/lein-template "0.1.0"
   :description "A Leiningen template for λ-blog."
   :url "https://github.com/Idorobots/lambda-blog"
   :license {:name "MIT License"


Cleanup perf test titles & imports

Cleanup perf test titles & imports

--- test/spec_tools/perf_test.clj
+++ test/spec_tools/perf_test.clj
@@ -3,8 +3,7 @@
             [schema.core :as schema]
             [schema.coerce :as coerce]
             [spec-tools.core :as st]
-            [criterium.core :as cc]
-            [clojure.spec :as s]))
+            [criterium.core :as cc]))

 ;;
 ;; start repl with `lein perf repl`
@@ -110,21 +109,21 @@
         sizes-schema #{(schema/enum :L :M :S)}]

     ; 4300ns
-    (title "spec: conform keyword enum - no-op")
+    (title "spec: conform keyword enum")
     (let [call #(st/conform sizes-spec ["L" "M"] st/string-conformations)]
       (assert (= (call) #{:L :M}))
       (cc/quick-bench
         (call)))

     ; 3700ns
-    (title "spec: conform keyword enum")
+    (title "spec: conform keyword enum - no-op")
     (let [call #(st/conform sizes-spec #{:L :M} st/string-conformations)]
       (assert (= (call) #{:L :M}))
       (cc/quick-bench
         (call)))

     ; 890ns
-    (title "schema: conform keyword enum - no-op")
+    (title "schema: conform keyword enum")
     (let [coercer (coerce/coercer sizes-schema coerce/string-coercion-matcher)
           call #(coercer #{:L :M})]
       (assert (= (call) #{:L :M}))
@@ -132,7 +131,7 @@
         (call)))

     ; 1100ns
-    (title "schema: conform keyword enum")
+    (title "schema: conform keyword enum - no-op")
     (let [coercer (coerce/coercer sizes-schema coerce/string-coercion-matcher)
           call #(coercer ["L" "M"])]
       (assert (= (call) #{:L :M}))


+her-name-is-luisa

+her-name-is-luisa

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -194,4 +194,11 @@
                                   (fo foo)))))))))

-
+(def her-name-is-luisa
+  (is (= "her name is Luisa"
+         (fo (generate {:synsem {:cat :verb :sem {:pred :be-called
+                                                  :subj {:pred :lei}
+                                                  :obj {:pred :luisa}}}})))))
+
+
+


s/medium/(medium)/

s/medium/(medium)/

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -277,7 +277,7 @@

 (deftest infinitive-vp
   (let [medium (medium)
-        vp-infinitive (:vp-infinitive (:grammar-map medium))
+        vp-infinitive (:vp-infinitive (:grammar-map (medium)))
         expr (-> vp-infinitive
                  (overh (get (:lexicon medium) "speak"))
                  (overc (generate {:synsem {:sem {:pred :word


s/lexicon/lex/

s/lexicon/lex/

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -106,15 +106,14 @@
 (def etre-test
   (is (not (nil? (first (filter #(= true (get-in % [:synsem :aux]))
                                 (get (:lexicon (small)) "être")))))))
-
 (deftest over-test
-  (let [lexicon (:lexicon (small))
+  (let [lex (:lexicon (small))
         grammar (:grammar (small))
         result
         (over grammar
-              (get lexicon "nous")
+              (get lex "nous")
               (over grammar
-                    (get lexicon "sommes") (get lexicon "aller")))]
+                    (get lex "sommes") (get lex "aller")))]
     (is (= 2 (count result)))
     (is (or (= (fo (nth result 0))
                "nous sommes allées")


Added not-found route

Added not-found route

--- src/compojure/route.clj
+++ src/compojure/route.clj
@@ -14,3 +14,8 @@
   (GET (add-wildcard path) {{file-path "*"} :params}
     (let [options (merge {:root "public"} options)]
       (file-response file-path options))))
+
+(defn not-found
+  "A route that returns a 404 not found response."
+  [body]
+  (ANY "*" [] {:status 404, :body body}))


Add bwasw test

Add bwasw test

--- test/clj_bwa/t_core.clj
+++ test/clj_bwa/t_core.clj
@@ -88,3 +88,37 @@
                  (str temp-dir "/test.fq")
                  (str temp-dir "/out.sam")
                  (bwa/samse-option))) => anything))
+
+;; sampe test
+;; ----------
+
+(with-state-changes [(before :facts (do (prepare-cache!)
+                                        (doseq [f test-db-files]
+                                          (fs/copy f (str temp-dir "/" (fs/base-name f))))
+                                        (fs/copy test-sai-file (str temp-dir "/test.sai"))
+                                        (fs/copy test-fq-file (str temp-dir "/test.fq"))))
+                     (after :facts (clean-cache!))]
+  (fact "about sampe"
+    (with-out-file temp-out
+      (bwa/sampe (str temp-dir "/test.fa")
+                 (str temp-dir "/test.sai") (str temp-dir "/test.sai")
+                 (str temp-dir "/test.fq") (str temp-dir "/test.fq")
+                 (str temp-dir "/out.sam")
+                 (bwa/sampe-option))) => anything))
+
+;; bwasw test
+;; ----------
+
+(with-state-changes [(before :facts (do (prepare-cache!)
+                                        (doseq [f test-db-files]
+                                          (fs/copy f (str temp-dir "/" (fs/base-name f))))
+                                        (fs/copy test-sai-file (str temp-dir "/test.sai"))
+                                        (fs/copy test-fq-file (str temp-dir "/test.fq"))))
+                     (after :facts (clean-cache!))]
+  (fact "about bwasw"
+    (with-out-file temp-out
+      (bwa/sw (str temp-dir "/test.fa")
+              (str temp-dir "/test.sai")
+              (str temp-dir "/test.fq")
+              (str temp-dir "/out.sam")
+              (bwa/sw-option))) => anything))


More index code thoughts.

More index code thoughts.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -12,11 +12,16 @@
   (:require
     [clojure.future :refer [pos-int?]]
     [clojure.spec :as s]
-    [merkledag.core :as mdag]
-    [merkledag.link :as link]
-    [merkle-db.data :as data]
-    [merkle-db.key :as key]
-    [merkle-db.partition :as part]))
+    (merkledag
+      [core :as mdag]
+      [link :as link]
+      [node :as node])
+    (merkle-db
+      [data :as data]
+      [key :as key]
+      [partition :as part]
+      ; TODO: is patch needed?
+      [patch :as patch])))

 ;; ## Specs
@@ -101,7 +106,7 @@
     part/data-type
     (part/read-all store node fields)

-    (throw (ex-info (str "Unsupported data-tree node type: "
+    (throw (ex-info (str "Unsupported index-tree node type: "
                          (pr-str (:data/type node)))
                     {:data/type (:data/type node)}))))

@@ -128,7 +133,7 @@
     part/data-type
     (part/read-batch store node fields record-keys)

-    (throw (ex-info (str "Unsupported data-tree node type: "
+    (throw (ex-info (str "Unsupported index-tree node type: "
                          (pr-str (:data/type node)))
                     {:data/type (:data/type node)}))))

@@ -153,20 +158,56 @@
           (drop-while #(key/before? (nth % 2) start-key))
         end-key
           (take-while #(key/after? end-key (nth % 1))))
-      ,,,
+      ,,,  ; FIXME
       #_
       (read-tablets store part fields tablet/read-range start-key end-key))

     part/data-type
     (part/read-range store node fields start-key end-key)

-    (throw (ex-info (str "Unsupported data-tree node type: "
+    (throw (ex-info (str "Unsupported index-tree node type: "
                          (pr-str (:data/type node)))
                     {:data/type (:data/type node)}))))

 ;; ## Update Functions
+
+;; Insertion
+;;
+;; Perform a search to determine what bucket the new record should go into.
+;;
+;;     If the bucket is not full (at most b − 1 {\displaystyle b-1} b-1 entries after the insertion), add the record.
+;;     Otherwise, split the bucket.
+;;         Allocate new leaf and move half the bucket's elements to the new bucket.
+;;         Insert the new leaf's smallest key and address into the parent.
+;;         If the parent is full, split it too.
+;;             Add the middle key to the parent node.
+;;         Repeat until a parent is found that need not split.
+;;     If the root splits, create a new root which has one key and two pointers. (That is, the value that gets pushed to the new root gets removed from the original node)
+;;
+;; B-trees grow at the root and not at the leaves.[1]
+
+
+;; Deletion
+;;
+;;     Start at root, find leaf L where entry belongs.
+;;     Remove the entry.
+;;         If L is at least half-full, done!
+;;         If L has fewer entries than it should,
+;;             If sibling (adjacent node with same parent as L) is more than half-full, re-distribute, borrowing an entry from it.
+;;             Otherwise, sibling is exactly half-full, so we can merge L and sibling.
+;;     If merge occurred, must delete entry (pointing to L or sibling) from parent of L.
+;;     Merge could propagate to root, decreasing height.
+
+
+(defn build-index
+  "Given a sequence of partitions, builds an index tree with the given
+  parameters incorporating the partitions."
+  [parameters partitions]
+  ; TODO: implement
+  (throw (UnsupportedOperationException. "NYI: build-index over partition sequence")))
+

 (defn update-tree
   "Apply a set of changes to the index tree rooted in the given node. The
@@ -175,23 +216,34 @@
   `:merkle-db.data/families`. Returns an updated persisted root node if any
   records remain in the tree."
   [store parameters root changes]
-  ; - If root is nil, divide up added records into a sequence of partitions and
-  ;   build an index over them.
-  ; - If root is a partition, apply changes to the partition. If the new
-  ;   partition is empty, return nil. If the partition exceeds the limit, split
-  ;   into smaller partitions and build an index over them.
-  ; - If root is an index node, divide up changes to match children and
-  ;   recurse for each child:
-  ;   - Apply changes by calling `update-tree*` which may return multiple nodes;
-  ;   - If result has one node, check that it is at least half-full.
-  ;     - If so, replace child link and continue.
-  ;     - If not, borrow from a sibling.
-  ;   - If multiple nodes, there is a _split_, so update the current root node.
-  ;   - If empty or nil, subtree became empty so remove child and key from node.
-  (throw (UnsupportedOperationException. "NYI: update data index tree")))
-
-
-; TODO: build index from list of partitions
+  (if (nil? root)
+    ; If root is nil, divide up added records into a sequence of partitions and
+    ; build an index over them.
+    (->> (patch/remove-tombstones changes)
+         (part/from-records store parameters)
+         (build-index parameters))
+    ; Check root node type.
+    (condp = (get-in root [::node/data :data/type])
+      ; If root is a partition, apply changes to the partition. If the new
+      ; partition is empty, return nil. If the partition exceeds the limit, split
+      ; into smaller partitions and build an index over them.
+      part/data-type
+        (throw (UnsupportedOperationException. "NYI: update data partition"))
+      ; If root is an index node, divide up changes to match children and
+      ; recurse for each child:
+      ; - Apply changes by calling `update-tree*` which may return multiple nodes;
+      ; - If result has one node, check that it is at least half-full.
+      ;   - If so, replace child link and continue.
+      ;   - If not, borrow from a sibling.
+      ; - If multiple nodes, there is a _split_, so update the current root node.
+      ; - If empty or nil, subtree became empty so remove child and key from node.
+      data-type
+        (throw (UnsupportedOperationException. "NYI: update data index tree"))
+
+      (throw (ex-info (str "Unsupported index-tree node type: "
+                           (pr-str (:data/type (::node/data root))))
+                      {:data/type (:data/type (::node/data root))})))))
+

 ;; ## Deletion Functions


update awesome busses example to reflect latest changes and thinking.

--- src/overtone/examples/busses/getonthebus.clj
+++ src/overtone/examples/busses/getonthebus.clj
@@ -1,56 +1,101 @@
 (ns overtone.examples.busses.getonthebus
   (:use overtone.live))

-;; Here's some code to help get you going with busses.
-;; (Audio busses to be precise, but I'm fuzzy enough on the
-;; difference between audio and control busses that I'm not
-;; going to attempt to explain it here).
-;;
 ;; Busses are like wires or pipes that you can use to connect the output
-;; of one synth to the inputs of one or more other synths.  (I haven't
-;; tried connecting the outputs of more than one synth to the same
-;; bus so I'm not sure how well that would work).
+;; of one synth to the inputs of one or more other synths.
+;; There are two types of busses - control busses and audio busses.

-;; First here are some busses to carry some signals
-(def tri-bus (audio-bus))
-(def sin-bus (audio-bus))
+;; Control busses are designed to carry control signals - values changing
+;; at a human rate (i.e. the speed you may turn a dial or slide a slider).
+
+;; Audio busses are designed to carry audio signals - values changing at
+;; a rate that makes them audible.
+
+;; Audio busses can carry both audio and control rate signals. However,
+;; they will use more computational resources. Therefore, consider using
+;; a control bus if you're signal doesn't need to change more than, say,
+;; 60 times a second.
+
+;; You can create many new control and audio busses. However, your system
+;; will start with one audio bus per audio input and one audio bus per audio
+;; output. For example, your left speaker is represented by audio bus 0
+;; and your right speaker is represented by audio bus 1
+
+;; Let's create some busses to carry some control rate signals
+
+;; We use the defonce construct to avoid new busses being created and
+;; assigned accidentally, if the forms get re-evaluated.
+(defonce tri-bus (audio-bus))
+(defonce sin-bus (audio-bus))

 ;; These are synths created to send data down the busses.
-;; They are set up so that you can use the ctl function after
-;; they're triggered to change the bus that they output on
-;; or the frequency at which their ugen is operating.
+;; They are set up so that you can modify both the bus they output on and
+;; their frequency whilst they're running via standard ctl messages.
+;;
+;; Note that we use the :kr variant of the out ugen. This tells the synth
+;; to output to a control bus rather than an audio bus which is the default.
 (defsynth tri-synth [out-bus 0 freq 5]
-  (out out-bus (lf-tri:ar freq)))
+  (out:kr out-bus (lf-tri:kr freq)))

 (defsynth sin-synth [out-bus 0 freq 5]
-  (out out-bus (sin-osc:ar freq)))
+  (out:kr out-bus (sin-osc:kr freq)))

-;; Evaluate these to start sending signals to the busses
-;; Note that if any of the subsequent instantiations of synths end up with
-;; synths that are not being modulated (i.e. that are just outputting a
-;; single frequency at an unchanging volume, or that sound like they
-;; aren't outputting anything at all) you probably need to re-evaluate
-;; one or both of these, and then possibly you'll need to kill and
-;; re-create the synths (I'm not sure why; seems like that shouldn't
-;; be necessary but that's how it goes).
+;; Probably the most important lesson about using busses is to understand that
+;; the execution of the synthesis on the server is strictly ordered. Running
+;; synths are placed in a node tree which is evaluated in a depth-first order.
+;; This is important to know because if you want synth instance A to be able to
+;; communicate with synth instance B via a bus, A needs to be *before* B in the
+;; synthesis node tree.
+
+;; The way to gain control over the order of execution within the synthesis tree
+;; is to use groups. Let's create some now:
+
+(defonce main-g (group "get-on-the-bus main"))
+(defonce early-g (group "early birds" :head main-g))
+(defonce later-g (group "latecomers" :after early-g))
+
+;; Let's create some source synths that will send signals on our busses. Let's
+;; also put them in the early group to ensure that their signals get sent first.
+
 (comment
-  (def tri-synth-inst (tri-synth tri-bus))
-  (def sin-synth-inst (sin-synth sin-bus))
+  (def tri-synth-inst (tri-synth :tgt early-g tri-bus))
+  (def sin-synth-inst (sin-synth :tgt early-g sin-bus))
   )

-;; These synths are what actually make sound (because their outputs
-;; are going to the 0 and 1 busses, a.k.a. the left and right channels
-;; of the audio output).
+;; Notice how these synths aren't making or controlling any sound. This is because
+;; they're control rate synths and also because their output is going to the busses
+;; we created which aren't connected to anything. The signals are therefore ignored.

-;; For each sample, this one reads the value off the bus (at audio rate)
+;; We can verify that they're running by viewing the node tree. We can do this
+;; easily with the following fn:
+(pp-node-tree)
+
+;; This will print the current synthesis node-tree to the REPL. This can get pretty
+;; hairy and large, but if you've only evaluated this tutorial since you started
+;; Overtone, it should be pretty manageable. You should be able to see the tri-synth
+;; and sin-synth within the early birds group, which itself is within the
+;; get-on-the-bus main group which itself is within the Overtone Default group.
+
+;; Now, let's use these signals to make actual noise!
+
+;; First, let's define a synth that we'll use to receive the signal from the bus to
+;; make some sound:
+
+(defsynth modulated-vol-tri [vol-bus 0 freq 220]
+  (out 0 (pan2 (* (in:kr vol-bus) (lf-tri freq)))))
+
+;; Notice how this synth is using the default audio rate version of the out
+;; ugen to output a signal to the left speaker of your computer. It is also
+;; possible to use out:ar to achieve the same result.
+
+;; This synth reads the value off the bus (at control rate)
 ;; and multiplies it with the lf-tri ugen's sample value.  The overall
-;; result is then sent to two busses: 0 and the one above it. (pan2 duplicates
+;; result is then sent to two consecutive busses: 0 and 1. (pan2 duplicates
 ;; a single channel signal to two channels; this is documented in more detail
 ;; in some of the getting-started examples).
-(defsynth modulated-vol-tri [vol-bus 0 freq 220]
-  (out 0 (pan2 (* (in:ar vol-bus) (lf-tri freq)))))

-;; This one is a little trickier.  It calculates the frequency
+
+;; This synth is a little trickier.  It calculates the frequency
 ;; by taking the sample value from the bus, multipling it by
 ;; the frequency amplitude, and then adding the result to the midpoint
 ;; or median frequency.  Therefore, if you hook it up to a bus carrying
@@ -58,7 +103,7 @@
 ;; you'll get an lf-tri ugen that oscillates between 165 and 275 Hz
 ;; (165 is 55 below 220, and 275 is 55 above 220)
 (defsynth modulated-freq-tri [freq-bus 0 mid-freq 220 freq-amp 55]
-  (let [freq (+ mid-freq (* (in:ar freq-bus) freq-amp))]
+  (let [freq (+ mid-freq (* (in:kr freq-bus) freq-amp))]
     (out 0 (pan2 (lf-tri freq)))))

@@ -67,8 +112,8 @@

 ;; Evaluate these to use the signals on the busses to modulate synth parameters
 (comment
-  (def mvt (modulated-vol-tri sin-bus))
-  (def mft (modulated-freq-tri sin-bus))
+  (def mvt (modulated-vol-tri :tgt later-g sin-bus))
+  (def mft (modulated-freq-tri :tgt later-g sin-bus))
   )

 ;; Fun fact: These two examples are key features
@@ -77,11 +122,8 @@
 ;; Switch the bus that is modulating the frequency
 ;; to be the triangle bus.
 ;;
-;; Note that we have to use its id because OSC (or maybe supercollider)
-;; is expecting a number, not a map (at least I think that's what's going on;
-;; feel free to correct this if it's something else happening).
 (comment
-  (ctl mft :freq-bus (:id tri-bus))
+  (ctl mft :freq-bus tri-bus)
   )

 ;; Change the frequency of the triangle wave on the tri-bus
@@ -93,7 +135,7 @@
 ;; Switch the modulated-vol-tri instance to be modulated by the triangle
 ;; bus as well.
 (comment
-  (ctl mvt :vol-bus (:id tri-bus))
+  (ctl mvt :vol-bus tri-bus)
   )

 ;; Kill the two things that are making noise
@@ -108,7 +150,7 @@

 ;; Or can re-use them!
 (comment
-  (def mvt-2 (modulated-vol-tri sin-bus 110))
+  (def mvt-2 (modulated-vol-tri :tgt later-g sin-bus 110))
   (kill mvt-2)
   )

@@ -117,12 +159,13 @@
   (do
     (ctl tri-synth-inst :freq 5)
     (ctl sin-synth-inst :freq 5)
-    (def mft-2 (modulated-freq-tri sin-bus 220 55))
-    (def mft-3 (modulated-freq-tri tri-bus 220 55)))
+    (def mft-2 (modulated-freq-tri :tgt later-g sin-bus 220 55))
+    (def mft-3 (modulated-freq-tri :tgt later-g tri-bus 220 55)))
   (ctl sin-synth-inst :freq 4)
   (kill mft-2 mft-3)
   )

 (comment
   "For when you're ready to stop all the things"
-  (stop))
+  (stop)
+  )


rudimentary support for `ns`

rudimentary support for `ns`

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -39,14 +39,19 @@
         (catch :default _
           false)))))

+(def current-ns (atom 'cljs.user))
+
+(defn ns-form? [form]
+  (and (seq? form) (= 'ns (first form))))
+
 (defn ^:export read-eval-print [line]
   (ns cljs.user)
-  (binding [ana/*cljs-ns* 'cljs.user
-            *ns* (create-ns 'cljs.user)
+  (binding [ana/*cljs-ns* @current-ns
+            *ns* (create-ns @current-ns)
             r/*data-readers* tags/*cljs-data-readers*]
     (with-compiler-env cenv
       (let [env (assoc (ana/empty-env) :context :expr
-                                       :ns {:name 'cljs.user}
+                                       :ns {:name @current-ns}
                                        :def-emits-var true)]
         (try
           (let [_ (when DEBUG (prn "line:" line))
@@ -59,10 +64,14 @@
                        (c/emit ast)))
                 _ (when DEBUG (prn "js:" js))]
             (try (prn (let [ret (js/eval js)]
-                        (when-not ('#{*1 *2 *3 *e} form)
+                        (when-not
+                          (or ('#{*1 *2 *3 *e} form)
+                            (ns-form? form))
                           (set! *3 *2)
                           (set! *2 *1)
                           (set! *1 ret))
+                        (when (ns-form? form)
+                          (reset! current-ns (second form)))
                         ret))
                  (catch js/Error e
                    (set! *e e)


Create a unique id for each fx since they are a list of structs.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -356,10 +356,12 @@
                                     (dom/td nil (om/build param-editor
                                                           {:cursor %1
                                                            :id id
-                                                           :set-state-ch set-state-ch})))
+                                                           :set-state-ch set-state-ch}
+                                                          {:key :id})))
                            cursor
                            (range))
             commit #(let [new-fx {:fx (:fx state)
+                                  :id (new-id)
                                   :params {}}]
                       (transition :open)
                       (om/transact! cursor (fn [c] (clj->js (into c [new-fx]))))


Add more asynch frendly bind implementation.

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -91,8 +91,9 @@
   composing operations with the `bind` function."
   [mv f]
   (let [ctx (ctx/get-current mv)]
-    (ctx/with-context ctx
-      (p/-mbind ctx mv f))))
+    (p/-mbind ctx mv (fn [v]
+                       (ctx/with-context ctx
+                         (f v))))))

 (defn mzero
   ([]


Trying out the prismatic schema stuff on the api

--- hyrax/src/clojure/hyrax/dist/api.clj
+++ hyrax/src/clojure/hyrax/dist/api.clj
@@ -1,14 +1,24 @@
-(ns hyrax.dist.api)
+(ns hyrax.dist.api
+  "A mechanism for coordinated distribution of hash buckets."
+  (:require [schema.core :as s]))

-(defprotocol Distributor "A mechanism for coordinated distribution of
-                                hash buckets."
+(defprotocol Distributor
+  (acquire-buckets* [this] )
+  (release-buckets* [this buckets] ))

-  (acquire-buckets! [this] "Returns the set of buckets currently available to a
-                   distributor instance. This function may return an empty set
-                   if no buckets are yet available. Must not block.")
+(s/defn ^:always-validate acquire-buckets! :- #{String}
+  "Returns the set of buckets currently available to a
+   distributor instance. This function may return an empty set
+   if no buckets are yet available. Must not block."
+  [this]
+  (acquire-buckets* this))

-  (release-buckets! [this buckets] "Releases the current set of buckets back to the
-                           cluster.  This method is a way of indicating that
-                           the client is done with the current set of buckets.
-                           The distributor is responsible for fetching the next
-                           set of buckets. Must not block."))
+(s/defn ^:always-validate release-buckets! :- nil
+  "Releases the current set of buckets back to the
+   cluster.  This method is a way of indicating that
+   the client is done with the current set of buckets.
+   The distributor is responsible for fetching the next
+   set of buckets. Must not block."
+  [this buckets :- #{String}]
+  (release-buckets* this buckets))
+


dissoc props marked with with-meta on defstyled

--- src/cljss/core.clj
+++ src/cljss/core.clj
@@ -68,21 +68,21 @@
    which produces React element and injects styles."
   [var tag styles]
   (let [tag (name tag)
-        [id static vals] (build-styles styles)
-        vals (vals->array vals)
-        attrs (->> styles (map second) (filterv keyword?))
-        attrs `(cljs.core/array ~@attrs)]
-    [tag id static vals attrs]))
+        [id static values] (build-styles styles)
+        values (vals->array values)
+        attrs (->> styles vals (filterv keyword?))]
+    [tag id static values attrs]))

 (defmacro make-styled []
   '(defn styled [cls static vars attrs create-element]
      (fn [props & children]
        (let [[props children] (if (map? props) [props children] [{} (apply vector props children)])
              var-class (->> vars (map (fn [[cls v]] (if (ifn? v) (array cls (v props)) (array cls v)))) (cljss.core/css cls static))
+             meta-attrs (->> vars (map second) (filter #(satisfies? IWithMeta %)) (map meta))
              className (:className props)
              className (str (when className (str className " ")) var-class)
              props (assoc props :className className)
-             props (apply dissoc props attrs)]
+             props (apply dissoc props (concat attrs meta-attrs))]
          (create-element props children)))))

 (defn- keyframes-styles [idx styles]


[#2620] Allow select same column in popup and point-color

--- backend/src/akvo/lumen/lib/visualisation/map_config.clj
+++ backend/src/akvo/lumen/lib/visualisation/map_config.clj
@@ -243,7 +243,7 @@
                                    (if (contains? date-column-set c)
                                      (str c "::text")
                                      c))
-                                 popup-columns)
+                                 (filter #(not= % (:columnName point-color-column)) popup-columns))
                             geom-column)
                 point-color-column (conj (str (sql-option-bucket-column point-color-column) " as " (:columnName point-color-column)))))]
     (format "select %s from %s where %s"


Invert scroll-left and scroll-right offset calculation

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -1236,7 +1236,7 @@
   "Scrolls the page left by specific number of pixels.
   The `scroll-offset` constant is used when not passed."
   ([driver offset]
-   (scroll-by driver offset 0))
+   (scroll-by driver (- offset) 0))
   ([driver]
    (scroll-left driver scroll-offset)))

@@ -1244,7 +1244,7 @@
   "Scrolls the page right by specific number of pixels.
   The `scroll-offset` constant is used when not passed."
   ([driver offset]
-   (scroll-by driver (- offset) 0))
+   (scroll-by driver offset 0))
   ([driver]
    (scroll-right driver scroll-offset)))


Adding the directory to execute fpm from

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -90,7 +90,7 @@
 (defn build-deb
   "Builds a deb"
   [project-name version os-data]
-  (let [status (sh "fpm" "-s" "dir" "-t" "deb" "-v" version "-n" project-name "/opt/opscode" "-m" "Opscode, Inc." "--post-install" "./debian/postinst" "--post-uninstall" "./debian/postrm" "--description" "The full stack install of Opscode Chef" "--url" "http://www.opscode.com")]
+  (let [status (sh "fpm" "-s" "dir" "-t" "deb" "-v" version "-n" project-name "/opt/opscode" "-m" "Opscode, Inc." "--post-install" "./debian/postinst" "--post-uninstall" "./debian/postrm" "--description" "The full stack install of Opscode Chef" "--url" "http://www.opscode.com" :dir "./pkg") ]
     (log-sh-result status
                    (str "Created debian package")
                    (str "Failed to create debian package"))))
@@ -98,7 +98,7 @@
 (defn build-rpm
   "Builds a rpm"
   [project-name version os-data]
-  (let [status (sh "fpm" "-s" "dir" "-t" "rpm" "-v" version "-n" project-name "/opt/opscode" "-m" "Opscode, Inc." "--post-install" "./debian/postinst" "--post-uninstall" "./debian/postrm" "--description" "The full stack install of Opscode Chef" "--url" "http://www.opscode.com")]
+  (let [status (sh "fpm" "-s" "dir" "-t" "rpm" "-v" version "-n" project-name "/opt/opscode" "-m" "Opscode, Inc." "--post-install" "./debian/postinst" "--post-uninstall" "./debian/postrm" "--description" "The full stack install of Opscode Chef" "--url" "http://www.opscode.com" :dir "./pkg")]
     (log-sh-result status
                    (str "Created rpm package")
                    (str "Failed to create rpm package"))))


update profile with test dependency so we can build uberjar (#204)

--- server/project.clj
+++ server/project.clj
@@ -51,6 +51,7 @@
   :profiles {:dev {:source-paths ["dev"]
                    :dependencies [[io.pedestal/pedestal.service-tools "0.5.1"]
                                   [org.clojure/test.check "0.9.0"]]}
-             :uberjar {:aot :all}}
+             :uberjar {:aot :all
+                       :dependencies [[org.clojure/test.check "0.9.0"]]}}
   :uberjar-name "spacon-server.jar"
   :main ^{:skip-aot true} spacon.server)


notes on component specific configuration unit test

--- test/clj/backtype/storm/integration_test.clj
+++ test/clj/backtype/storm/integration_test.clj
@@ -408,6 +408,15 @@
 ;;       )))

+(deftest test-component-specific-config
+  ;; test that java api can override confs (both via IComponent and fluent interface)
+  ;; test that fluent interface has highest priority
+  ;; test which serialization is chosen
+  ;;   - make the component specific one throw an error, but the topology one work fine
+  ;;   - use something that's only serializable via component specific serialization
+  ;; check that max spout pending is correct
+  )
+
 (deftest test-acking-branching-complex
   ;; test acking with branching in the topology
   )


Cap keys woo!

Cap keys woo!

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -28,11 +28,11 @@
 (defn execute-cap
   "Executes a capability."
   [cap & {store :store kdf :kdf scheme :scheme}]
-  (let [{index :index key :key} (crypto/derive kdf cap)
+  (let [{index :index cap-key :cap-key} (crypto/derive kdf cap)
         blob (<!! (retrieve store index))
-        encoded-plan (crypto/decrypt scheme key blob)
-        plan (nippy/thaw encoded-plan)
-        sub-results (execute plan)]
+        encoded-plan (crypto/decrypt scheme cap-key blob)
+        plan (spy (nippy/thaw encoded-plan))
+        sub-results (spy (execute plan))]
     (async/into {} sub-results)))

 (defn revoke-cap


Refactor

Refactor

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -14,14 +14,13 @@
 (defn create-cap
   "Creates a capability."
   [plan {:keys [store kdf scheme]}]
-  (let [error (spy (check-plan plan))]
-    (if (nil? error)
-      (let [cap (crypto/make-cap)
-            {:keys [index cap-key]} (crypto/derive kdf cap)
-            blob (crypto/encrypt scheme cap-key (nippy/freeze plan))]
-        (md/chain (store/create! store index blob)
-                  (constantly {:cap cap})))
-      (md/success-deferred {:error error}))))
+  (if-let [error (check-plan plan)]
+    (md/success-deferred {:error error})
+    (let [cap (crypto/make-cap)
+          {:keys [index cap-key]} (crypto/derive kdf cap)
+          blob (crypto/encrypt scheme cap-key (nippy/freeze plan))]
+      (md/chain (store/create! store index blob)
+                (constantly {:cap cap})))))

 (defn execute-cap
   "Executes a capability."


refine gerund creation rules

refine gerund creation rules

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -54,7 +54,7 @@
     (re-find #"ie$" stem)
     (str (replace stem #"..$" "y") "ing")

-    (re-find #"..e$" stem) ;; "..": avoid matching two-letter word "be"
+    (re-find #".[^aeiou]e$" stem) ;; "..": avoid matching two-letter word "be"
     (str (replace stem #"e$" "") "ing")

     (re-find #"[eu]m$" stem)
@@ -63,13 +63,13 @@
     (re-find #"[ou]p$" stem)
     (str (replace stem #"p$" "pp") "ing")

-    (re-find #"[a]n$" stem)
+    (re-find #"[^e][a]n$" stem)
     (str (replace stem #"n$" "nn") "ing")

     (re-find #"[ou]b$" stem)
     (str (replace stem #"b$" "bb") "ing")

-    (re-find #"[eou]t$" stem)
+    (re-find #"[^aeiou][eou]t$" stem)
     (str (replace stem #"t$" "tt") "ing")

     true


unified target card naming in Aggressive Neg, Back Channels, Bioroid Efficiency Research, Restoring Face, Shipment from SS, Trick of Light

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -46,7 +46,8 @@
    "Aggressive Negotiation"
    {:req (req (:scored-agenda corp-reg)) :prompt "Choose a card"
     :choices (req (cancellable (:deck corp) :sorted))
-    :effect (effect (move target :hand) (shuffle! :deck))}
+    :effect (effect (move target :hand) (shuffle! :deck))
+    :msg "search R&D for a card and add it to HQ"}

    "An Offer You Cant Refuse"
    {:prompt "Choose a server" :choices ["HQ" "R&D" "Archives"]
@@ -83,7 +84,7 @@
    "Back Channels"
    {:prompt "Choose an installed card in a server to trash" :choices {:req #(= (last (:zone %)) :content)}
     :effect (effect (gain :credit (* 3 (:advance-counter target))) (trash target))
-    :msg (msg "trash " (if (:rezzed target) (:title target) " a card") " and gain "
+    :msg (msg "trash " (card-str state target) " and gain "
               (* 3 (:advance-counter target)) " [Credits]")}

    "Bad Times"
@@ -103,7 +104,7 @@

    "Bioroid Efficiency Research"
    {:choices {:req #(and (= (:type %) "ICE") (has? % :subtype "Bioroid") (not (:rezzed %)))}
-    :msg (msg "rez " (:title target) " at no cost")
+    :msg (msg "rez " (card-str state target {:visible true}) " at no cost")
     :effect (effect (rez target {:no-cost true})
                     (host (get-card state target) (assoc card :zone [:discard] :seen true)))}

@@ -374,7 +375,7 @@

    "Restoring Face"
    {:prompt "Choose a Sysop, Executive or Clone to trash"
-    :msg (msg "trash " (:title target) " to remove 2 bad publicity")
+    :msg (msg "trash " (card-str state target) " to remove 2 bad publicity")
     :choices {:req #(and (:rezzed %)
                          (or (has? % :subtype "Clone") (has? % :subtype "Executive")
                              (has? % :subtype "Sysop")))}
@@ -423,7 +424,7 @@
                      {:choices {:req #(or (card-is? % :advanceable :always)
                                           (and (card-is? % :advanceable :while-rezzed) (:rezzed %))
                                           (= (:type %) "Agenda"))}
-                      :msg (msg "place " c " advancement tokens on " (if (:rezzed target) (:title target) "a card"))
+                      :msg (msg "place " c " advancement tokens on " (card-str state target))
                       :effect (effect (add-prop :corp target :advance-counter c {:placed true}))} card nil)))}

    "Shoot the Moon"
@@ -548,8 +549,7 @@
                                          :effect  (effect (add-prop :corp target :advance-counter c {:placed true})
                                                           (add-prop :corp fr :advance-counter (- c) {:placed true})
                                                           (system-msg (str "moves " c " advancement tokens from "
-                                                                           (if (:rezzed fr) (:title fr) "a card") " to "
-                                                                           (if (:rezzed target) (:title target) "a card"))))}
+                                                                           (card-str state fr) " to " (card-str state target))))}
                                         tol nil)))}
                       card nil)))}


Remove tmp server boilerplate.

Remove tmp server boilerplate.

--- src/clj/geschichte/tmp_server.clj
+++ src/clj/geschichte/tmp_server.clj
@@ -1,32 +0,0 @@
-(ns geschichte.tmp-server
-  (:require [cemerick.austin.repls :refer (browser-connected-repl-js)]
-            [ring.adapter.jetty :refer [run-jetty]]
-            [net.cgrand.enlive-html :as enlive]
-            [compojure.route :refer (resources)]
-            [compojure.core :refer (GET defroutes)]
-            [clojure.java.io :as io]) )
-
-
-                                        ; ring server for cljs repl and testing
-(enlive/deftemplate page
-  (io/resource "public/index.html")
-  []
-  [:body] (enlive/append
-           (enlive/html [:script (browser-connected-repl-js)])))
-
-
-(defroutes site
-  (resources "/")
-  (GET "/*" req (page)))
-
-
-#_(def html-server (run-jetty #'site {:port 8080 :join? false}))
-#_(.stop html-server)
-
-
-;; fire up repl, remove later
-#_(do
-    (ns geschichte.repl-server)
-    (def repl-env (reset! cemerick.austin.repls/browser-repl-env
-                          (cemerick.austin/repl-env)))
-    (cemerick.austin.repls/cljs-repl repl-env))


agent log client -> swallow ex for 400/404 (dead containers) #260

--- src/clj/swarmpit/agent/client.clj
+++ src/clj/swarmpit/agent/client.clj
@@ -21,11 +21,20 @@

 (defn logs
   [agent-url container-id since]
-  (-> (execute {:method  :GET
-                :api     (str "/logs/" container-id)
-                :url     agent-url
-                :options {:query-params
-                          (merge {}
-                                 (when since
-                                   {:since since}))}})
-      :body))
+  (try
+    (let [result (-> (execute {:method  :GET
+                               :api     (str "/logs/" container-id)
+                               :url     agent-url
+                               :options {:query-params
+                                         (merge {}
+                                                (when since
+                                                  {:since since}))}})
+                     :body)]
+      (println result)
+      result)
+    (catch Exception ex
+      (let [e (ex-data ex)]
+        (print e)
+        (if (.contains [400 404] (:status e))
+          nil
+          (throw ex))))))


Update version

Update version

--- src/cljs/gc_api_browser/core.cljs
+++ src/cljs/gc_api_browser/core.cljs
@@ -11,7 +11,7 @@
             [gc-api-browser.tabbed-request :as tabbed-request]))

 (def default-headers {"Authorization"      "FILL ME IN"
-                      "GoCardless-Version" "2015-04-29"
+                      "GoCardless-Version" "2015-07-06"
                       "Accept"             "application/json"
                       "Content-Type"       "application/json"})


sort deck in selection modal by date

sort deck in selection modal by date

--- src/cljs/netrunner/gamelobby.cljs
+++ src/cljs/netrunner/gamelobby.cljs
@@ -76,7 +76,7 @@
       [:div.deck-collection
        (let [players (:players (some #(when (= (:gameid %) gameid) %) games))
              side (:side (some #(when (= (:user %) user) %) players))]
-         (for [deck decks :when (= (get-in deck [:identity :side]) side)]
+         (for [deck (sort-by :date > decks) :when (= (get-in deck [:identity :side]) side)]
            [:div.deckline {:on-click #(send {:action "deck" :gameid gameid :deck deck})
                            :data-dismiss "modal"}
             [:img {:src (image-url (:identity deck))}]


refactoring move

refactoring move

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -83,6 +83,18 @@
   [board moves]
   (reduce apply-conversion board moves))

+(defn- to-game-transition
+  [board moves]
+  {:transition moves
+   :scores 0                         ;; TODO - Put a score diff (more by player, less by player)
+   :board (delay (apply-conversions board moves))})
+
+(defn- add-empty-cell-conversion
+  [moves]
+  (if-let [move (first moves)]
+    (conj moves (empty-cell-conversion (:winner move) (:point move)))
+    moves))
+
 ;; -----------------------------------------
 ;; Public API
 ;; -----------------------------------------
@@ -110,17 +122,11 @@
   [board]
   (map-values
     (partial map-values
-      (fn [moves]
-        (if-let [move (first moves)]
-          (let [all-moves (conj moves (empty-cell-conversion (:winner move) (:point move)))]
-            {:transition all-moves                          ;; TODO - Add empty move (or add one to score...)
-             :scores 0                                      ;; TODO - Put a score diff (more by player, less by player)
-             :board (delay (apply-conversions board all-moves))}))
-        ))
+      #(to-game-transition board (add-empty-cell-conversion %)))

     (transduce
-      (mapcat #(available-conversions-at board %))
-      (group-by-reducer [:winner :point])
+      (mapcat #(available-conversions-at board %))          ;; TODO - Cut that in two? (moves vs transitions)
+      (group-by-reducer [:winner :point])                   ;; TODO - it creates nil...
       (board/empty-cells board))
     ))


ideas

ideas

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -104,7 +104,8 @@
 ;; TODO - Tree of turn can be mapped to tree of game
 ;; TODO - Tree of game allows to move between games (play-move)
 ;; TODO - Tree of game allows to move between ai fake games
-;; TOOD => play-move becomes useless for the turn !
+;; TODO => play-move becomes useless for the turn !
+;; TODO /!\ memory usage might explode? the tree will not be cut...

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


refactor and documentation

refactor and documentation

--- src/cljx/geschichte/p2p/auth.cljx
+++ src/cljx/geschichte/p2p/auth.cljx
@@ -15,7 +15,9 @@
   [meta]
   (set (keys (:causal-order meta))))

-(defn- new-commits! [store metas]
+(defn- new-commits!
+  "Computes difference between local and remote repo"
+  [store metas]
   (go (->> (for [[user repos] metas
                  [repo meta] repos]
              (go {:new meta
@@ -42,7 +44,9 @@
 ;;     On your backend server, verify that the code is valid and exchange it for a long-lived token, which is stored in your database and sent back to be stored on the client device as well.
 ;;     The user is now logged in, and doesn’t have to repeat this process again until their token expires or they want to authenticate on a new device.

-(defn- meta-published [pub-ch store trusted-hosts sessions [new-in out]]
+(defn- meta-published
+  "Checks wether the user has a running session, the host is trusted und verifies credentials if the user ist not authenticated"
+  [pub-ch store trusted-hosts sessions credential-fn [new-in out]]
   (go-loop [{:keys [metas topic] :as p} (<! pub-ch)]
     (when (= topic :meta-pub)
      (let [nc (<! (new-commits! store metas))]
@@ -60,15 +64,24 @@
                   (do
                    (>! out {:topic ::auth-required :users (set (map :user not-auth)) :tries-left (- 5 counter)})
                    (<! (go-loop [p (<! pub-ch)]
-                         (if (= (:topic p) ::authed)
-                           (swap! sessions (fn [old new] (apply assoc old new)) (:users p))
+                         (if (= (:topic p) ::auth)
+                           (swap! sessions (fn [old new] (apply assoc old new))
+                                  (->> (:users p)
+                                       (map
+                                        (fn [[k v]]
+                                          (vec [k
+                                                (if (credential-fn {:username k :password v})
+                                                  (-> {(uuid) (java.util.Date.)})
+                                                  nil)])))
+                                       flatten))
                            (recur (<! pub-ch)))))
-                   (recur (inc counter))))
-                 ))))))
+                   (recur (inc counter))))))))))
     (recur (<! pub-ch))))

-(defn- auth-required [auth-req-ch auth-fn out]
+(defn- auth-required
+  "Sends the credntials of given users back using a given authentication function"
+  [auth-req-ch auth-fn out]
   (go-loop [{:keys [users] :as a} (<! auth-req-ch)]
     (when a
       (debug "AUTH-REQ" users)
@@ -78,27 +91,13 @@
       (recur (<! auth-req-ch)))))

-(defn- authenticated [auth-ch pub-ch credential-fn]
-  (go-loop [a (<! auth-ch)]
-    (when a
-      (let [authed-users {:topic ::authed
-                          :users (->> (:users a)
-                                      (map
-                                       (fn [[k v]]
-                                         (vec [k
-                                               (if (credential-fn {:username k :password v})
-                                                 (-> {(uuid) (java.util.Date.)})
-                                                 nil)])))
-                                      flatten)}]
-        (>! pub-ch authed-users))
-      (recur (<! auth-ch)))))
-
-
-(defn- in-dispatch [{:keys [topic]}]
+(defn- in-dispatch
+  "Dispatches incoming requests"
+  [{:keys [topic]}]
   (case topic
     :meta-pub :meta-pub
     ::auth-required ::auth-required
-    ::auth ::auth
+    ::auth :meta-pub
     :unrelated))

@@ -115,17 +114,15 @@
         sessions (atom {})
         p-in (pub in in-dispatch)]
     (sub p-in :meta-pub pub-ch)
-    (meta-published pub-ch store trusted-hosts sessions [new-in out])
+    (meta-published pub-ch store trusted-hosts sessions credential-fn [new-in out])

     (sub p-in ::auth-required auth-req-ch)
     (auth-required auth-req-ch auth-fn out)

-    (sub p-in ::auth auth-ch)
-    (authenticated auth-ch pub-ch credential-fn)
-
     (sub p-in :unrelated new-in)

     [new-in out]))
+

 (comment
@@ -155,14 +152,9 @@
                                             nil))
                                (atom #{})
                                [in out])]
-
-    #_(go-loop [o (<! out)]
-      (println "OUT" o)
-      (recur (<! out)))
     (go-loop [i (<! new-in)]
       (println "NEW-IN" i)
       (recur (<! new-in)))
-
     (go
       (>! in {:topic :meta-pub,
               :peer "STAGE",
@@ -202,8 +194,6 @@
       (println "OUT" (<! out))
       ))

-
   (println "\n")

-
   )


[n.d.alert] Fix bug with neutral button

[n.d.alert] Fix bug with neutral button

--- src/clojure/neko/dialog/alert.clj
+++ src/clojure/neko/dialog/alert.clj
@@ -41,8 +41,8 @@
   {:attributes [:neutral-text :neutral-callback]}
   [^AlertDialog$Builder builder,
    {:keys [neutral-text neutral-callback]} _]
-  (.setNegativeButton builder (res/get-string (.getContext builder) neutral-text)
-                      (listeners/on-click-call neutral-callback)))
+  (.setNeutralButton builder (res/get-string (.getContext builder) neutral-text)
+                     (listeners/on-click-call neutral-callback)))

 (defelement :alert-dialog-builder
   :classname AlertDialog$Builder


Fixing tests for lattice-{one,zero}

Fixing tests for lattice-{one,zero}

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

--- src/conexp/tests/fca/lattices.clj
+++ src/conexp/tests/fca/lattices.clj
@@ -115,15 +115,17 @@

 (deftest test-lattice-one
   (with-testing-data [lattice testing-data]
-    (let [one (lattice-one lattice)]
-      (forall [x (base-set lattice)]
-        ((order lattice) x one)))))
+    (=> (not-empty (base-set lattice))
+        (let [one (lattice-one lattice)]
+          (forall [x (base-set lattice)]
+                  ((order lattice) x one))))))

 (deftest test-lattice-zero
   (with-testing-data [lattice testing-data]
-    (let [zero (lattice-zero lattice)]
-      (forall [x (base-set lattice)]
-        ((order lattice) zero x)))))
+    (=> (not-empty (base-set lattice))
+        (let [zero (lattice-zero lattice)]
+          (forall [x (base-set lattice)]
+                  ((order lattice) zero x))))))

 (deftest test-directly-neighboured?
   (with-testing-data [lattice testing-data]


Issue-4744: Include `query-params` in CPE search

--- src/ctia/entity/vulnerability.clj
+++ src/ctia/entity/vulnerability.clj
@@ -147,8 +147,9 @@
          (ctia-store/query-string-search store
                                          {:full-text {:query (build-configurations-query cpe-matches)}}
                                          identity-map
-                                         {:fields [:configurations.nodes :id]
-                                          :sort {:id :asc}})
+                                         (merge {:fields [:configurations.nodes :id]
+                                                 :sort {:id :asc}}
+                                                query-params))
          ids (cpe/vulnerabilities->ids cpe-matches data)]
      (if-let [next-params (:next paging)]
        (concat ids (vulnerability-ids-affected-by-cpe-matches {:cpe-matches cpe-matches


be less lazy

be less lazy

--- src/pc/mailgun.clj
+++ src/pc/mailgun.clj
@@ -1,12 +1,9 @@
 (ns pc.mailgun
   (:require [cheshire.core :as json]
             [clj-http.client :as http]
-            [pc.profile]))
-
-(def base-url pc.profile/mailgun-base-url)
-
-(def api-key pc.profile/mailgun-api-key)
+            [pc.profile :as profile]))

 (defn send-message [{:keys [from to cc bcc subject text html] :as props}]
-  (http/post (str (base-url) "messages") {:basic-auth ["api" (api-key)]
-                                          :form-params props}))
+  (http/post (str (profile/mailgun-base-url) "messages")
+             {:basic-auth ["api" (profile/mailgun-api-key)]
+              :form-params props}))


fix NON_NULL on NON_NULL issue and field name nil issue

--- src/graphql_clj/introspection.clj
+++ src/graphql_clj/introspection.clj
@@ -36,11 +36,11 @@
       (let [tag (:tag type)
             name (:name type)]
         (cond
+          (= :list-type tag) :LIST ; has to be before :NON_NULL
           (:required type) :NON_NULL
           (and (= :basic-type tag)
                (contains? #{'Int 'Float 'String 'Boolean 'ID} name)) :SCALAR
           (= :basic-type tag) :OBJECT
-          (= :list-type tag) :LIST
           (= :type-definition tag) :OBJECT ; root query kind
           (= :union-definition tag) :UNION
           (= :interface-definition tag) :INTERFACE
@@ -50,11 +50,11 @@
           :else (assert nil (format "Unhandled type kind for type: %s" type)))))))

 (defn field-kind [field]
-  (assert (:tag field) (format "field tag is nil for type: %s" field))
-  (assert (:name field) (format "field name is nil for type: %s" field))
   (let [tag (:tag field)
         name (:name field)
         type (:type field)]
+    (assert tag (format "field tag is nil for type: %s" field))
+    (assert name (format "field name is nil for type: %s" field))
     (cond
       (= :type-field tag) (type-kind type)
       :else (throw (ex-info (format "unknown field kind for field: %s" field) {:field field})))))
@@ -68,27 +68,26 @@
                       (get-in field [:type :name]))
         type (:type field)
         kind (field-kind field)
-        inner-type (get-in field [:type :inner-type])]
+        inner-type (or (get-in field [:type :inner-type])
+                       (if (= :NON_NULL kind)
+                         (dissoc type :required)))]
     (assert kind (format "field kind is nil for field: %s" field))
     (if (#{:LIST} kind)
       (assert inner-type (format "field inner-type is nil for field: %s" field)))
     (assert (or type-name inner-type) (format "field type-name and inner-type are both nil for field: %s" field))
-    (if (= :NON_NULL kind)
-      {:kind kind
-       :inner-type (dissoc type :required)}
-      {:name (:name field)
-       :description (:description field)
-       :args (:arguments field) ; defer resolving of arguments
-
-       ;; :type nil ; defer resolving of type
-       :type-name type-name
-       :kind kind
-       :inner-type inner-type
-       :required (:required field)
-
-       :isDeprecated false ; TODO
-       :deprecationReason nil ; TODO
-       })))
+    {:name (:name field)
+     :description (:description field)
+     :args (:arguments field) ; defer resolving of arguments
+
+     ;; :type nil ; defer resolving of type
+     :type-name type-name
+     :kind kind
+     :inner-type inner-type
+     :required (:required field)
+
+     :isDeprecated false ; TODO
+     :deprecationReason nil ; TODO
+     }))

 (defn type-resolver [type]
   (let [kind (type-kind type)
@@ -194,22 +193,21 @@
   (let [type (:type arg)
         type-name (:name type)
         kind (type-kind (:type arg))
-        inner-type (get-in arg [:type :inner-type])]
+        inner-type (or (get-in arg [:type :inner-type])
+                       (if (= :NON_NULL kind)
+                         (dissoc type :required)))]
     (assert kind (format "argument kind is nil for: %s" arg))
     (when (#{:LIST} kind)
       (assert inner-type (format "inner-type is nil for type: %s" arg)))
     (assert (or type-name inner-type) (format "Both type-name and inner-type are nil for arg:%s" arg))
     (println "args-resolver: arg:" arg)
-    (if (= :NON_NULL kind)
-      {:kind kind
-       :inner-type (dissoc type :required)}
-      {:name (:name arg)
-       :description (:description arg)
-
-       ;; defer resolving of type for argument
-       :type-name type-name
-       :kind kind
-       :inner-type inner-type
-       :required (:required arg)
-
-       :defaultValue (:default-value arg)})))
+    {:name (:name arg)
+     :description (:description arg)
+
+     ;; defer resolving of type for argument
+     :type-name type-name
+     :kind kind
+     :inner-type inner-type
+     :required (:required arg)
+
+     :defaultValue (:default-value arg)}))


text/html representation for items resource has been expanded to provide more meaningful information

--- src/kixi/hecuba/web/resources.clj
+++ src/kixi/hecuba/web/resources.clj
@@ -19,19 +19,26 @@
   :handle-ok (fn [{projects ::projects {mt :media-type} :representation :as ctx}]
                (case mt
                  "text/html"
-                 (html [:body
-                        [:table
-                         [:thead
-                          [:tr
-                           [:th "Name"]
-                           [:th "Project code"]
-                           [:th "Debug"]]]
-                         [:tbody
-                          (for [p projects]
+                 (let [debug false
+                       fields (remove #{:name :id :href :type} (keys (first projects)))]
+                   (html [:body
+                          [:h2 "Fields"]
+                          [:ul (for [k fields] [:li (name k)])]
+                          [:h2 "Items"]
+                          [:table
+                           [:thead
                             [:tr
-                             [:td [:a {:href (:href p)} (:name p)]]
-                             [:td (:project-code p)]
-                             [:td (pr-str p)]])]]])
+                             [:th "Name"]
+                             (for [k fields] [:th k])
+                             (when debug [:th "Debug"])]]
+                           [:tbody
+                            (for [p projects]
+                              [:tr
+                               [:td [:a {:href (:href p)} (:name p)]]
+                               (for [k fields] [:td (k p)])
+                               (when debug [:td (pr-str p)])])]]
+
+                          ]))
                  "application/edn" (pr-str (vec projects))
                  projects))
   :post! (fn [{{body :body} :request}]


Adjust log message

Adjust log message

--- src/layzee/use_cases/lazy_web.clj
+++ src/layzee/use_cases/lazy_web.clj
@@ -8,7 +8,7 @@
      #(nil? (:retweeted_status %1)))

 (defn- result[search-fn conversation-fn log-fn how-many]
-  (let [result (timing/time #(apply search-fn [{:count how-many :filter no-retweets}])       #(log-fn "It took <%sms> to search. Found <%s> tweets."  (:duration %) (count result)))]
+  (let [result (timing/time #(apply search-fn [{:count how-many :filter no-retweets}])       #(log-fn "It took <%sms> to search."  (:duration %)))]
     (let [results-with-replies (timing/time #(doall (pmap (partial conversation-fn) result)) #(log-fn "It took <%sms> to find replies to <%s> tweets" (:duration %) (count result)))]
       {
        :timestamp (t/now)


swap-state now uses react 0.13.x setState directly with function.

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -114,11 +114,15 @@
   "Swap the \"value\" key of a component's state."
   ([tx-fn] (swap-state *component* tx-fn))
   ([component tx-fn]
-   (let [old-state (get-state component)
-         new-state (tx-fn old-state)]
-     (when (not= old-state new-state)
-       (set-state component new-state))))
-  )
+    ;; TODO: setstate callback fn
+    ;; TODO: swap-state tx-fn accepts old-props as second arg?
+   (.setState component (fn [s _]
+                          (let [old-state (aget s "value")
+                                new-state (tx-fn old-state)]
+                            (if (= old-state new-state)
+                              #js{}
+                              #js{:value new-state}))))))
+
 (defn get-props
   "Get the render args from a component's props."
   ([] (get-props *component*))


Remove reflection warning from function fail.

--- src/main/clojure/cascade/fail.clj
+++ src/main/clojure/cascade/fail.clj
@@ -16,7 +16,8 @@
 (defn fail
   "A quick way to throw a RuntimeException."
   [#^String fmt & args]
-  (throw (RuntimeException. (apply format fmt args))))
+  (let [#^String msg (apply format fmt args)]
+    (throw (RuntimeException. msg))))

 (defmacro fail-unless
   "Throws a runtime exception if the condition is false. The message is generated from the format


Simplifing symbol-padding function.

Simplifing symbol-padding function.

--- src/refac/core.clj
+++ src/refac/core.clj
@@ -10,7 +10,7 @@
     "protected"
     "internal"})

-(def punctuation
+(def special-characters
   #{
     "{" "}"
     "(" ")"
@@ -37,25 +37,21 @@
                            symbols)
           :else (recur (next symbols)
                        (cons symbol namespace))
-        )
-      )
-    )
+        )))))
+
+(defn process-class [symbols]
+  (let [symbol (first symbols)])
   )
-)
-
-(defn process-import [symbols]
-  (println "import")
-  symbols)

 (defn process-symbols [symbols]
-  (loop [symbols symbols]
-    (if (not (nil? symbols))
-      (let [symbol (first symbols)]
-        (recur
-          (cond
-            (= symbol "package") (process-package (next symbols))
-            (= symbol "import")  (process-import (next symbols))
-            :else (next symbols)))))))
+  (if (not (nil? symbols))
+    (let [symbol (first symbols)]
+      (recur
+        (case symbol
+          "package" (process-package (next symbols))
+          "import"  (process-package (next symbols))
+          "class"   (process-class (next symbols))
+          (next symbols))))))

 (defn read-java [] (slurp "test.java"))

@@ -65,16 +61,10 @@

 (defn pad-all-symbols
   [str]
-  (loop [p (vec punctuation)
-         s str]
-    (if (empty? p)
-      s
-      (recur
-        (rest p)
-        (pad-symbol s (first p)))
-    )
-  )
-)
+  (reduce
+    (fn [acc item] (pad-symbol acc item))
+    str
+    special-characters))

 (defn get-symbol-stream
   []
@@ -83,9 +73,7 @@
     (str/split
       (pad-all-symbols
         (read-java))
-      #"\s")
-    )
-  )
+      #"\s")))

 (defn -main
   [& args]


repl have now: done, undone, nth

repl have now: done, undone, nth

--- src/todos/core.clj
+++ src/todos/core.clj
@@ -41,10 +41,29 @@
     (println ((todolist :name)))
     (let [[cmd & args] (inp/user-cmd-input ">> ")
           current-todo (or (first @current-stack) todolist)
-          joined-args  (stri/join " " args)]
+          joined-args  (stri/join " " args)
+          find-by-name (fn [todos-seq compare-name]
+                         (loop [todos todos-seq]
+                           (cond
+                             (empty? todos)
+                             nil
+                             (= (((first todos) :name)) compare-name)
+                             (first todos)
+                             :else
+                             (recur (rest todos))
+                             )))
+          ]
       (cond
+        ;
+        ; show
+        ;
         (= cmd "ls")
         ((current-todo :print) "")
+        ;
+        (= cmd "plain")
+        (println ((current-todo :plain)))
+        ;
+        ; create
         ;
         (= cmd "create")
         ((current-todo :todo-add) (t-item/todo-create joined-args))
@@ -52,8 +71,27 @@
         (= cmd "note")
         ((current-todo :note-add) joined-args)
         ;
-        (= cmd "plain")
-        (println ((current-todo :plain)))
+        ; manipulation
+        ;
+        (= cmd "done")
+        (if (empty? args)
+          ((current-todo :set-done) true)
+          (let [m (find-by-name ((current-todo :todos)) joined-args)]
+            (if m
+              ((m :set-done) true)
+              (println "Konnte Todo nicht finden")
+              )))
+        ;
+        (= cmd "undone")
+        (if (empty? args)
+          ((current-todo :set-done) false)
+          (let [m (find-by-name ((current-todo :todos)) joined-args)]
+            (if m
+              ((m :set-done) false)
+              (println "Konnte Todo nicht finden")
+              )))
+        ;
+        ; navigation
         ;
         (= cmd "first")
         (let [ft (first ((current-todo :todos)))]
@@ -66,10 +104,17 @@
         (swap! current-stack rest)
         ;
         (= cmd "cd")
-        (loop [todos ((current-todo :todos))]
-          (if (= (((first todos) :name)) joined-args)
-            (swap! current-stack conj (first todos))
-            (recur (rest todos))
+        (let [m (find-by-name ((current-todo :todos)) joined-args)]
+          (if m
+            (swap! current-stack conj m)
+            (println (format "Es existiert kein Subtodo namens \"%s\"." joined-args))
+            ))
+        ;
+        (= cmd "nth")
+        (let [n (- (read-string joined-args) 1)]
+          (if (and (integer? n) (>= n 0) (< n (count ((current-todo :todos)))))
+            (swap! current-stack conj (nth ((current-todo :todos)) n))
+            (println "Id ist ungültig. Es gibt nur" (count ((current-todo :todos))))
             ))
         )
       ; exit clause


state can be nil

state can be nil

--- src/twarc/core.clj
+++ src/twarc/core.clj
@@ -35,8 +35,9 @@

 (defn make-job
   [{:keys [ns name arguments identity group desc recovery durably state]
-    :or {identity (-> (UUID/randomUUID) str)}}]
-  (-> (JobBuilder/newJob (if state TwarcStatefullJob TwarcJob))
+    :or {identity (-> (UUID/randomUUID) str)}
+    :as opts}]
+  (-> (JobBuilder/newJob (if (contains? opts :state) TwarcStatefullJob TwarcJob))
       (.usingJobData (JobDataMap. {"ns" ns
                                    "name" name
                                    "arguments" arguments


WIP commit, starting to fix letfn lifting

--- src/oxcart/passes/lambda_lift.clj
+++ src/oxcart/passes/lambda_lift.clj
@@ -31,6 +31,13 @@
     [nil seq]))

+(defn map-vals
+  [m f & args]
+  (->> (for [[k v] m]
+         [k (apply f v args)])
+       (into {})))
+
+
 (defn fn*->cannonical-fn*
   [[_fn* & more]]
   (let [[_sym more] (take-when symbol? more)]
@@ -47,11 +54,35 @@
                   ~@body)))))

-(defn rewrite-locals-to-vars
+(defn rewrite-locals
   [mapping ast]
   (if (pattern/local? ast)
     (get mapping (:name ast) ast)
     ast))
+
+
+(defn fix [f dat]
+  (let [dat' (f dat)]
+    (if (= dat dat')
+      dat
+      (recur f dat'))))
+
+
+(defn merge-deps
+  [mapping]
+  (->> (for [[k v] mapping]
+         [k (->> v
+                 (map mapping)
+                 (keep identity)
+                 (reduce union v))])
+       (into {})))
+
+
+(defn rewrite-closed-overs
+  [mapping binding]
+  (let [name (pattern/binding->symbol binding)]
+    (assoc-in binding [:init :closed-overs] (get mapping name))))
+

 (defn lift-fns
@@ -91,28 +122,49 @@
         ;;
         ;; 2. Create a (declare <fns>) in the defs atom.
         ;;
-        ;; 3. For each fn in the letfn rewrite the letfn bodies using
-        ;;    the mapping from 1 and emit lifted defs as would be
-        ;;    normal for lambda lifting.
-        ;;
-        ;; 4. Replace the letfn* with a simple let* that binds the
+        ;; 3. Compute the closure over the closed-overs, that is
+        ;;    update the closed-overs of each function in the letfn
+        ;;    to be the fixed point union of the closed-overs.
+        ;;
+        ;; 4. Having computed the updated closed-over sets, rewrite
+        ;;    all the functions to eliminate the closed over
+        ;;    arguments. Note that at each step of this rewrite all of
+        ;;    the function bodies must be traversed
+        ;;
+        ;; 5. For each fn in the letfn rewrite the letfn bodies using
+        ;;    the mapping from 1.
+        ;;
+        ;; 6. Emit lifted defs as would be normal for lambda lifting.
+        ;;
+        ;; 7. Replace the letfn* with a simple let* that binds the
         ;;    partials appropriately so that I don't have to rewrite
         ;;    all the locals of the body expression.

-        (let [bindings     (:bindings ast)
-              locals->vars (atom {})
-              env          (:env ast)]
+        (let [bindings             (:bindings ast)
+              locals->vars         (atom {})
+              locals->closed-overs (atom {})
+              env                  (:env ast)]

           ;; create the forward defs
           (doseq [b bindings]
-            (let [sym (-> b
-                          pattern/binding->value
-                          pattern/fn->name
-                          symbol)
+            (let [sym                      (-> b
+                                               pattern/binding->value
+                                               pattern/fn->name
+                                               symbol)
                   {:keys [statements ret]} (util/ast `(do (def ~sym)
                                                           ~sym)
                                                      env)
-                  def-ast (first statements)]
+                  def-ast                  (first statements)]
+
+              ;; save the closed-overs
+              (swap! locals->closed-overs
+                     assoc (pattern/binding->symbol b)
+                           (->> b
+                                pattern/binding->value
+                                :closed-overs
+                                vals
+                                (map :name)
+                                set))

               ;; save the def ast
               (swap! defs-atom conj def-ast)
@@ -120,16 +172,40 @@
               ;; save the var ast
               (swap! locals->vars assoc (pattern/binding->symbol b) ret)))

-          (-> ast
-              (assoc :bindings (mapv #(ast/prewalk %1
-                                        (partial rewrite-locals-to-vars
-                                                 @locals->vars))
-                                     bindings))
-
-              (collect-closed-overs {:what #{:closed-overs} :where #{:fn}})
-
-              ;; force to a let form
-              (assoc :op :let)))
+
+          ;; compute the fixed point over the local bindings
+          (swap! locals->closed-overs
+                 (fn [locals->closed-overs]
+                   (fix merge-deps
+                        locals->closed-overs)))
+
+          (println @locals->closed-overs)
+
+          (let [;; rewrite the bindings to share closed-over information
+                bindings' (mapv (partial rewrite-closed-overs
+                                         locals->closed-overs)
+                                bindings)
+
+                fns       (zipmap (map pattern/binding->symbol bindings')
+                                  (map pattern/binding->value  bindings'))
+
+                ;; compute the mapping from symbols to partial applications
+                fns'      (map-vals fns
+                                    (partial lift-fns defs-atom))]
+            (println fns')
+
+            (-> ast
+                (assoc :bindings (->> bindings'
+                                      (mapv (fn [binding]
+                                              (ast/prewalk binding
+                                                           (partial rewrite-locals
+                                                                    fns'))))
+                                      (mapv #(ast/prewalk %1
+                                                          (partial rewrite-locals
+                                                                   @locals->vars)))))
+
+                ;; force to a let form
+                (assoc :op :let))))

         true


Add example to docstring demonstrating usage of rdf-serializer

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -394,6 +394,11 @@
 (defn rdf-serializer
   "Coerces destination into an java.io.Writer using
   clojure.java.io/writer and returns an RDFSerializer.
+
+  Use this to capture the intention to write to a location in a
+  specific RDF format, e.g.
+
+  (grafter.rdf/add (rdf-serializer \"/tmp/foo.nt\" :format :nt) quads)

   Accepts also the following optional options:


change-active-board handler: check minor board winner from state

Instead of calculating the winner each time, just check the situation on main board to see if the given minor board has been finished.

--- src/ultimate_ttt/ui/handlers.cljs
+++ src/ultimate_ttt/ui/handlers.cljs
@@ -26,10 +26,10 @@

 (register-handler
   :change-active-board
-  (fn [db [_ clicked-cell-index]]
-    (let [next-board (get-in db [:boards clicked-cell-index])]
-      (if-not (referee/find-winner next-board)
-        (assoc db :active-board clicked-cell-index)
+  (fn [db [_ next-board-index]]
+    (let [main-board (:main-board db)]
+      (if (h/cell-active? main-board next-board-index) ; check if the next board hasn't been finished yet
+        (assoc db :active-board next-board-index)
         (assoc db :active-board nil)))))

 (defn updated-main-board