bump deps

bump deps

--- build.boot
+++ build.boot
@@ -3,18 +3,18 @@
 (set-env!
  :source-paths    #{"src/main"}
  :resource-paths  #{"resources"}
- :dependencies '[[org.clojure/clojurescript   "1.9.89"         :scope "provided"]
-                 [org.omcljs/om               "1.0.0-alpha37"  :scope "provided"]
-                 [com.ladderlife/cellophane   "0.3.2"          :scope "provided"]
+ :dependencies '[[org.clojure/clojurescript   "1.9.93"         :scope "provided"]
+                 [org.omcljs/om               "1.0.0-alpha38"  :scope "provided"]
+                 [com.ladderlife/cellophane   "0.3.3"          :scope "provided"]
                  [com.cognitect/transit-clj   "0.8.285"        :scope "test"]
                  [devcards                    "0.2.1-7"        :scope "test"]
                  [com.cemerick/piggieback     "0.2.1"          :scope "test"]
                  [pandeiro/boot-http          "0.7.3"          :scope "test"]
                  [adzerk/boot-cljs            "1.7.228-1"      :scope "test"]
                  [adzerk/boot-cljs-repl       "0.3.2"          :scope "test"]
-                 [adzerk/boot-test            "1.1.1"          :scope "test"]
+                 [adzerk/boot-test            "1.1.2"          :scope "test"]
                  [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]
-                 [adzerk/boot-reload          "0.4.8"          :scope "test"]
+                 [adzerk/boot-reload          "0.4.11"          :scope "test"]
                  [adzerk/bootlaces            "0.1.13"         :scope "test"]
                  [org.clojure/tools.nrepl     "0.2.12"         :scope "test"]
                  [org.clojure/tools.namespace "0.3.0-alpha3"   :scope "test"]


[#112038333] Output generated sources

[#112038333] Output generated sources

--- build.boot
+++ build.boot
@@ -45,6 +45,7 @@
   []
   (comp (build-dev)
         (gzip :regex [#".html$" #".css$" #".js$"])
+        (target)
         ; (s3-sync)
         ; (sync-bucket)
         ))


add comment for dev task

add comment for dev task

--- build.boot
+++ build.boot
@@ -18,6 +18,7 @@
          '[tailrecursion.boot.task.ring   :refer [dev-server]])

 (deftask dev
+  "Continuously recompile and serve slides locally."
   []
   (println "Serving slides at http://localhost:8000/triclojure-deck.html")
   (comp (watch)


update refresh-db task

update refresh-db task

--- build.boot
+++ build.boot
@@ -41,6 +41,7 @@
 ;; Load testing tasks
 (require '[adzerk.boot-test :refer :all])

+;; Load datomic Move this task into its own file
 (require '[datomic.api :as d])

 (deftask dev []
@@ -56,4 +57,6 @@
         _ (d/delete-database datomic-uri)
         _ (d/create-database datomic-uri)
         conn (d/connect datomic-uri)]
-    (d/transact conn (load-file "resources/datomic/schema.edn"))))
+    @(d/transact conn (load-file "resources/datomic/schema.edn"))
+    @(d/transact conn (load-file "resources/datomic/roles.edn"))
+    @(d/transact conn (load-file "resources/datomic/users.edn"))))


Update prop-types dep to 15.6.0-0

Update prop-types dep to 15.6.0-0

--- build.boot
+++ build.boot
@@ -10,7 +10,7 @@
                  [org.clojure/clojurescript "1.9.946"     :scope "provided"]
                  [com.stuartsierra/dependency "0.2.0"]
                  [rum "0.10.8"]
-                 [cljsjs/prop-types "15.5.10-1"]])
+                 [cljsjs/prop-types "15.6.0-0"]])

 (def +version+ "0.3.0")
 (def github "https://github.com/martinklepsch/derivatives")


updated deps

updated deps

--- build.boot
+++ build.boot
@@ -1,6 +1,6 @@
 (set-env!
  :resource-paths #{"resources"}
- :dependencies '[[org.clojure/clojure "1.6.0" :scope "provided"]
-                 [com.joshuadavey/boot-middleman "0.0.5" :scope "test"]])
+ :dependencies '[[org.clojure/clojure "1.9.0" :scope "provided"]
+                 [com.joshuadavey/boot-middleman "0.0.7" :scope "test"]])

 (require '[com.joshuadavey.boot-middleman :refer [middleman]])


rm unused args

rm unused args

--- build.boot
+++ build.boot
@@ -70,11 +70,7 @@
    running the resulting executable) is that the client does not have the
    necessary permissions to start a new process, e.g. to start an Alda server
    via the client."
-  [a app              APP     str  "The Alda application to run (server, repl or client)."
-   x args             ARGS    str  "The string of CLI args to pass to the client."
-   p port             PORT    int  "The port on which to start the server/worker."
-   w workers          WORKERS int  "The number of workers for the server to start."
-   F alda-fingerprint         bool "Allow the Alda client to identify this as an Alda process."]
+  [x args ARGS str "The string of CLI args to pass to the client." ]
   (comp
     (javac)
     (with-pass-thru fs


Update play-cljs template

Update play-cljs template

--- build.boot
+++ build.boot
@@ -11,7 +11,7 @@
                   [org.clojure/clojure "1.9.0-alpha15"]
                   [leiningen "2.7.0" :exclusions [leiningen.search]]
                   [ring "1.4.0"]
-                  [play-cljs/lein-template "0.10.1"]
+                  [play-cljs/lein-template "0.10.1-3"]
                   [eval-soup "1.2.1" :exclusions [org.clojure/core.async]]
                   [org.eclipse.jgit/org.eclipse.jgit "4.6.0.201612231935-r"]])


Fix format-commands #10

Fix format-commands #10

--- build.boot
+++ build.boot
@@ -156,8 +156,8 @@
         (compile-cljs :id "node/index")
         (target)
         (with-pass-thru _
-          (util/dosh "/bin/sh" "-c" "'cd target")
-          (util/dosh "/bin/bash" "-c" "'cd target")
+          (util/dosh "/bin/sh" "-c" "'cd target'")
+          (util/dosh "/bin/bash" "-c" "'cd target'")
           (util/dosh "bash" "-c" "'cd target ; ls -l'"))))))
         ;(with-pass-thru _
         ;  (run-commands ["cd" "target/node"] ["node" "index.js"]))))))


Fix format-commands #8

Fix format-commands #8

--- build.boot
+++ build.boot
@@ -151,7 +151,7 @@
         (target)
         (show :fileset true)
         (with-pass-thru _
-          (util/dosh "ls" "-l")
+          (util/dosh "sh" "-c" "cd" "target" "ls" "-l")
           (run-commands ["cd" "target/node"] ["node" "index.js"]))))))

 (deftask autotest


Update plan-schema dependency version

Update plan-schema dependency version

--- build.boot
+++ build.boot
@@ -31,7 +31,7 @@
                     [com.fzakaria/slf4j-timbre    "0.3.5"]
                     [org.clojure/tools.logging    "0.3.1"]
                     [com.novemberain/langohr      "3.7.0"]
-                    [dollabs/plan-schema          "0.3.7"]
+                    [dollabs/plan-schema          "0.3.8"]
                     ;; web server
                     [org.clojure/data.json        "0.2.6"]
                     [ring/ring-core               "1.6.0"]


added fixture to docker http test

added fixture to docker http test

--- test/clj/swarmpit/docker/http_test.clj
+++ test/clj/swarmpit/docker/http_test.clj
@@ -1,8 +1,11 @@
 (ns swarmpit.docker.http-test
   (:refer-clojure :exclude [get])
   (:require [clojure.test :refer :all]
+            [swarmpit.test :refer :all]
             [swarmpit.docker.http :refer :all])
   (:import (clojure.lang ExceptionInfo)))
+
+(use-fixtures :once dind-socket-fixture)

 (deftest ^:integration http
   (testing "execute"


Engage fun.

Engage fun.

--- src/cljs/onyx_dashboard/components/deployment.cljs
+++ src/cljs/onyx_dashboard/components/deployment.cljs
@@ -21,22 +21,26 @@

 (defcomponent deployment-indicator [{:keys [deployment last-entry]} owner]
   (render [_]
-          (let [crashed? (= :crashed (:status (:status deployment)))]
+          (let [crashed? (= :crashed (:status (:status deployment)))
+                onyx-logo-rotation (mod (* (:message-id last-entry)
+                                           10)
+                                        360)
+                rotation-css (str "rotate(" onyx-logo-rotation "deg)")]
             (dom/div
               (p/panel
-                {:header (om/build section-header
-                                   {:text "Dashboard Status"
-                                    :hide-expander? true
-                                    :type :job-management}
-                                   {})
+                {:header (dom/div {} (dom/h4 {:class "unselectable"} "Dashboard Status"))
                  :bs-style (if (or crashed? (not (:up-to-date? deployment)))  "danger" "primary")}
-                (dom/div
-                 (if crashed?
-                   (dom/div
-                    "Log replay crashed. Cluster probably died if the dashboard is using the same version of Onyx."
-                    (dom/pre {}
-                             (:error (:status deployment)))))
-                 (dom/div (str "Display status as of " (.fromNow (js/moment (str (js/Date. (:created-at last-entry)))))))))))))
+                (dom/div
+                  (if crashed?
+                    (dom/div "Log replay crashed. Cluster probably died if the dashboard is using the same version of Onyx."
+                             (dom/pre {}
+                                      (:error (:status deployment)))))
+                  (dom/div
+                    (dom/img {:style {:-ms-transform rotation-css
+                                      :-webkit-transform rotation-css
+                                      :transform rotation-css}
+                              :src "/img/high-res.png" :height 25 :width 25})
+                    (str " Display status as of " (.fromNow (js/moment (str (js/Date. (:created-at last-entry)))))))))))))

 (defcomponent deployment-peers [deployment owner]
   (render [_]


simplify (defn)

simplify (defn)

--- src/babel/francais.cljc
+++ src/babel/francais.cljc
@@ -35,10 +35,8 @@
                  truncate-children true
                  model (medium)}}]
    (let [result (generate/generate spec model)]
-     (if (keyword? result)
-       (throw (Exception. (str "please don't send me a keyword :( : this is what you sent me: " result)))
-       (conj {:surface (morph result)}
-             result)))))
+     (conj {:surface (morph result)}
+           result))))

 (defn parse
   "parse a string in French into zero or more (hopefully more) phrase structure trees"


(defn lightning-bolts []): group by parent

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -98,7 +98,7 @@
      (add-all-comps-with-paths [bolt] language-model total-depth
                                (find-comp-paths-in (bolt-depth bolt))
                                truncate-children max-total-depth))
-   bolts))
+   (reduce concat bolts)))

 ;; TODO: make this non-recursive by using mapcat.
 (defn add-all-comps-with-paths [bolts language-model total-depth comp-paths truncate-children max-total-depth]
@@ -258,7 +258,7 @@
         ;; expression, which might involve several parent lightning bolts.
         parents (shuffle (candidate-parents grammar spec))]
     (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
-          (lazy-mapcat (fn [parent]
+          (mapfn (fn [parent]
                          (if (= false (get-in parent [:head :phrasal] false))
                            (let [candidate-lexemes (get-lex parent :head index)
                                  filter-on-spec {:synsem {:cat (get-in parent [:head :cat] :top)
@@ -277,12 +277,12 @@
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (and (< total-depth max-total-depth)
                    (= true (get-in spec [:head :phrasal] true)))
-            (lazy-mapcat (fn [parent]
-                           (over/overh parent
-                                       (lightning-bolts language-model (get-in parent [:head])
-                                                        (+ 1 depth) (+ 1 total-depth)
-                                                        :max-total-depth max-total-depth)))
-                         parents)
+            (mapfn (fn [parent]
+                     (over/overh parent
+                                 (lightning-bolts language-model (get-in parent [:head])
+                                                  (+ 1 depth) (+ 1 total-depth)
+                                                  :max-total-depth max-total-depth)))
+                   parents)
             (do
               (log/debug (str "hit max-total-depth: " max-total-depth ": will not generate phrasal head children."))
               nil))]


logging and adding dag_unify.core/assoc-in

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -1,16 +1,16 @@
 (ns babel.generate
-  (:refer-clojure :exclude [get-in deref resolve find parents])
+  (:refer-clojure :exclude [assoc-in get-in deref resolve find parents])
   (:require
    [babel.index :refer [intersection-with-identity]]
    [babel.over :as over :refer [show-bolt spec-info truncate truncate-expressions]]
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [clojure.string :as string]
-   [dag_unify.core :refer [copy fail-path get-in fail? strip-refs unify unify!]]))
+   [dag_unify.core :refer [assoc-in copy fail-path get-in fail? strip-refs unify unify!]]))

 ;; during generation, will not decend deeper than this when creating a tree:
 ;; TODO: should also be possible to override per-language.
-(def ^:const max-total-depth 6)
+(def ^:const max-total-depth 2)

 ;; TODO support setting max-generated-complements to :unlimited
 (def ^:const max-generated-complements 20000)
@@ -105,65 +105,89 @@
 (defn comp-paths-to-bolts-map
   "return a map between the set of all complements in the given _bolt_,and the lazy sequence of bolts for that spec."
   [bolt model depth max-depth]
-  (if (not (nil? bolt))
-    (let [comp-paths (find-comp-paths bolt)
-          result
-          (zipmap
-           comp-paths
-           (map #(let [spec (get-in bolt %)
-                       lexemes (get-lexemes model spec)
-                       bolts-at (if (< depth max-depth)
-                                  (lightning-bolts
-                                   model
-                                   (get-in bolt %)
-                                   depth max-depth))
-                       lexemes-before-phrases
-                     (lexemes-before-phrases depth max-depth)]
-                   (log/trace (str "comp-paths-to-bolts-map:"
-                                   ((:morph-ps model) bolt) "@" % " -> "
-                                   (spec-info spec) " lexemes-before-phrases: "
+  (if (and (not (nil? bolt))
+           (< depth max-depth))
+    (let [comp-paths (find-comp-paths bolt)]
+      (if (not (empty? comp-paths))
+        (let [debug (log/trace (str "comp-paths-to-bolts-map: start: "
+                                    ((:morph-ps model) bolt)
+                                    " with comp-paths: " (string/join ";" comp-paths)))
+              result
+              (zipmap
+               comp-paths
+               (map #(let [spec (get-in bolt %)
+                           debug (log/trace (str "comp-paths-to-bolts-map: "
+                                                 "finding bolts for path:" % " within bolt: " ((:morph-ps model) bolt)))
+                           lexemes (get-lexemes model spec)
+                           bolts-at (if (< depth max-depth)
+                                      (lightning-bolts
+                                       model
+                                       (get-in bolt %)
+                                       depth max-depth))
+                           lexemes-before-phrases
+                           (lexemes-before-phrases depth max-depth)]
+                       (log/trace (str "comp-paths-to-bolts-map:"
+                                       ((:morph-ps model) bolt) "@" % " -> "
+                                       (spec-info spec) " lexemes-before-phrases: "
                                    lexemes-before-phrases))
-                   (if lexemes-before-phrases
-                     (concat lexemes bolts-at)
-                     (concat bolts-at lexemes)))
-                comp-paths))]
-      (doall (map #(log/debug
-                    (str "comp-paths-to-bolt-map: " (show-bolt bolt model) "@:" % ":"
-                         (string/join "," (map (fn [bolt] (show-bolt bolt model))
-                                               (get result %)))))
-                  (sort (keys result))))
-      result)))
+                       (if lexemes-before-phrases
+                         (concat lexemes bolts-at)
+                         (concat bolts-at lexemes)))
+                    comp-paths))]
+          (doall (map #(log/trace
+                        (str "comp-paths-to-bolt-map: for bolt: " (show-bolt bolt model) "@" % " returning:"
+                             (string/join "," (map (fn [bolt] (show-bolt bolt model))
+                                                   (get result %)))))
+                      (sort (keys result))))
+          result)))))

 (defn add-comps
-  "return a bolt with a model and comp-paths."
+  "given a bolt, return the lazy sequence of all bolts derived from this bolt after adding,
+   at each supplied path in comp-paths, the bolts for that path."
   [bolt model comp-paths bolts-at-paths depth max-depth & [top-bolt path-from-top]]
-  (log/debug (str "add-comps:"
-                  " with depth: (" depth "/" max-depth ") and spec-info:"
+  (log/trace (str "add-comps:"
+                  " with depth: (" depth "/" max-depth ") and top-bolt:"
                   ((:morph-ps model) top-bolt)
                   (if (not (= bolt top-bolt))
                     (str " /" path-from-top "/ "
                          ((:morph-ps model) bolt)))))
   (let [top-bolt (or top-bolt bolt)]
     (if (empty? comp-paths)
-      bolt ;; done: we've added all the comps to the bolt, so just return the bolt.
+      [bolt] ;; done: we've added all the comps to the bolt, so just return the bolt as a singleton vector.
+      ;; else, more comp-paths to go.
       (mapcat #(add-comps % model
                           (rest comp-paths)
-                          (rest bolts-at-paths))
+                          (rest bolts-at-paths)
+                          depth max-depth top-bolt path-from-top)
               (let [path (first comp-paths)
                     bolts-at (first bolts-at-paths)]
                 (mapcat (fn [bolt-at]
-                          (let [comps-map (comp-paths-to-bolts-map bolt-at model (+ 1 depth) max-depth)
-                                comp-paths (sort (keys comps-map))]
-                            (when (not (some empty? (vals comps-map)))
-                              (add-comps bolt-at
-                                       model
-                                       comp-paths
-                                       (map (fn [path]
-                                              (get comps-map path))
-                                            comp-paths)
-                                       (+ 1 depth)
-                                       max-depth top-bolt (str (if path-from-top (str path-from-top "/"))
-                                                               path)))))
+                          (log/debug (str "add-comps:" " adding bolt:"
+                                          ((:morph-ps model) bolt-at)
+                                          " for path:" path " to bolt:"
+                                          (show-bolt bolt model)
+                                          "; top-bolt:"
+                                          ((:morph-ps model) top-bolt)))
+                          (if (= false (get-in bolt-at [:phrasal]))
+                            [(assoc-in
+                              bolt
+                              path
+                              bolt-at)]
+
+                            (let [comps-map (comp-paths-to-bolts-map bolt-at model (+ 1 depth) max-depth)
+                                  comp-paths (sort (keys comps-map))]
+                              (when (not (some empty? (vals comps-map)))
+                                (add-comps bolt-at
+                                           model
+                                           comp-paths
+                                           (map (fn [path]
+                                                  (get comps-map path))
+                                                comp-paths)
+                                           (+ 1 depth)
+                                           max-depth
+                                           top-bolt
+                                           (str (if path-from-top (str path-from-top "/"))
+                                              path))))))
                         bolts-at))))))
 (defn generate2
   "Return all expressions matching spec _spec_ given the model _model_."
@@ -213,7 +237,9 @@
   [language-model spec depth total-depth
                        & {:keys [max-total-depth]
                           :or {max-total-depth max-total-depth}}]
-  (log/debug (str "lightning-bolt with depth: (" depth "/" max-total-depth ") and spec-info:"
+  (if (nil? spec)
+    (exception (str "given a null spec for lightning-bolts.")))
+  (log/trace (str "lightning-bolts: depth: (" depth "/" max-total-depth ") and spec-info:"
                  (spec-info spec)))
   (let [grammar (:grammar language-model)
         depth (if depth depth 0)
@@ -229,7 +255,7 @@
           (when (= false (get-in spec [:head :phrasal] false))
             (lazy-mapcat
              (fn [parent]
-               (log/debug (str "lightning-bolts: parent: " (:rule parent) " over lexical heads."))
+               (log/trace (str "lightning-bolts: parent: " (:rule parent) " over lexical heads."))
                (let [lexicon (or (:lexicon (:generate language-model)) (:lexicon language-model))
                      subset (if-let [index-fn (:index-fn language-model)]
                               (do
@@ -263,7 +289,7 @@
           (if (and (< depth max-total-depth)
                    (= true (get-in spec [:head :phrasal] true)))
             (lazy-mapcat (fn [parent]
-                           (log/debug (str "parent: " (:rule parent) " over phrasal heads."))
+                           (log/trace (str "lightning-bolts: parent: " (:rule parent) " over phrasal heads."))
                            (mapcat #(over/overh parent %)
                                    (lightning-bolts language-model (get-in parent [:head])
                                                     (+ 1 depth) (+ 1 total-depth)
@@ -440,14 +466,15 @@
         []))

 (defn find-comp-paths [bolt & [path]]
-  (let [path (if (nil? path)
-               (rest (find-end-of-bolt bolt))
-               path)]
-    (if (not (empty? path))
-      (concat
-       [(vec (concat path [:comp]))]
-       (find-comp-paths bolt (rest path)))
-      [[:comp]])))
+  (if (not (= false (get-in bolt [:phrasal])))
+    (let [path (if (nil? path)
+                 (rest (find-end-of-bolt bolt))
+                 path)]
+      (if (not (empty? path))
+        (concat
+         [(vec (concat path [:comp]))]
+         (find-comp-paths bolt (rest path)))
+        [[:comp]]))))

 (defn find-comp-paths-in [depth]
   (cond
@@ -487,9 +514,9 @@
                     (string/join "," (map :rule result))
                     " for spec: " (strip-refs spec)))
     (if (empty? result)
-      (log/debug (str "candidate-parents: "
+      (log/trace (str "candidate-parents: "
                       "no parents found for spec: " (spec-info spec)))
-      (log/debug (str "candidate-parents: "
+      (log/trace (str "candidate-parents: "
                     (string/join "," (map :rule result))
                     " for: " (spec-info spec))))
     result))


~(defn gen): remove unused param 'at-path'

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -47,7 +47,7 @@

 (defn gen
   "Return a lazy sequence of every possible tree given a specification and a model."
-  [spec model depth & [from-bolts at-path]]
+  [spec model depth & [from-bolts]]
   (log/trace (str "gen@" depth "; spec=" (show-spec spec)))
   (when (< depth max-depth)
     (let [bolts (or from-bolts
@@ -66,15 +66,11 @@
               ;; ..otherwise it's a phrase, so return the lazy
               ;; sequence of adding all possible complements at every possible
               ;; position at the bolt.
-              (if true
-                (add-comps-to-bolt bolt model
-                                   (reverse (comp-paths depth)))
-                [bolt])))
-           (gen spec model depth
-                (rest bolts)
-                at-path)))
+              (add-comps-to-bolt bolt model
+                                 (reverse (comp-paths depth)))))
+           (gen spec model depth (rest bolts))))
         (if (not (= false (get-in spec [:phrasal] true)))
-          (gen spec model (+ 1 depth) nil at-path))))))
+          (gen spec model (+ 1 depth)))))))

 (defn get-bolts-for [model spec depth]
   (let [result
@@ -187,7 +183,7 @@
 (defn add-to-bolt-at-path
   "bolt + path => partial trees"
   [bolt path model]
-  (let [complements (gen (get-in bolt path) model 0 nil path)]
+  (let [complements (gen (get-in bolt path) model 0)]
     (if (empty? complements)
       (let [error-message
             (str "(improve grammar): no complements found for: "


simplify

simplify

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -139,16 +139,15 @@
                 (flatten
                  (mapfn
                   (fn [bolt-at]
-                    (add-bolt-at top-bolt bolt path bolt-at model depth max-depth))
+                    (let [bolt (assoc-in bolt path bolt-at)]
+                      (add-bolt-at top-bolt bolt path bolt-at model depth max-depth)))
                   bolts-at))))))))

 (defn add-bolt-at [top-bolt bolt path bolt-at model depth max-depth]
   (lazy-seq
    (mapfn #(do-defaults % model)
           (if (= false (get-in bolt-at [:phrasal]))
-            [(if (= bolt bolt-at)
-               bolt
-               (assoc-in bolt path bolt-at))]
+            [bolt]
             (let [comp-paths (find-comp-paths bolt-at)
                   comp-bolts (pmap #(comp-path-to-bolts bolt-at % model (+ 1 depth) max-depth)
                                    comp-paths)]


s/truncate-children/truncate/

s/truncate-children/truncate/

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -75,16 +75,16 @@
    (morph/analyze surface-form lexicon)))

 (defn generate
-  [spec & {:keys [do-enrich max-total-depth model truncate-children]
+  [spec & {:keys [do-enrich max-total-depth model truncate]
            :or {do-enrich true
                 max-total-depth generate/max-total-depth
                 model medium
-                truncate-children true}}]
+                truncate true}}]
   (log/debug (str "generating with spec: " (strip-refs spec) " with max-total-depth: " max-total-depth))
   (let [result (engine/generate spec model
                                 :do-enrich do-enrich
                                 :max-total-depth max-total-depth
-                                :truncate-children truncate-children)]
+                                :truncate-children truncate)]
     (if result
       (conj {:surface (fo result)}
             result))))


Test for function configuration-handler

Test for function configuration-handler

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -497,6 +497,25 @@
                      :api_prefix "/api"
                      :hostname   "hostname"
                      :test       "/api"} "hostname")))))
+
+(deftest test-configuration-handler
+    "Check the function emender-jenkins.rest-api/configuration-handler."
+    (testing "the function emender-jenkins.rest-api/configuration-handler."
+        (with-redefs [send-response (fn [response request] response)]
+            (let [request {:configuration
+                              {:config
+                                  {:verbose-show-configuration true}
+                               :info
+                                  {:version "1.0"}
+                               :api
+                                  {:prefix "/api"}}}]
+                (is (= (configuration-handler request)
+                       {:config
+                           {:verbose-show-configuration true}
+                            :info
+                                {:version "1.0"}
+                                 :api
+                                     {:prefix "/api"}}))))))

 (deftest test-system-banners
     "Check the function emender-jenkins.rest-api/system-banners."


Fix syncing of non-accumulated jobs

Fix syncing of non-accumulated jobs

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -125,7 +125,8 @@
          (map build-for)
          (ignore-old-runs-for-rerun-stages job-instance)
          accumulate-builds)
-    (build-for job-instance)))
+    (dissoc (build-for job-instance)
+            :actual-stage-run)))

 (defn job-data-for-instance [jobInstance]
   (assoc jobInstance :build (build-for-job jobInstance)))


add version task

add version task

--- src/cake/tasks/help.clj
+++ src/cake/tasks/help.clj
@@ -35,4 +35,8 @@
   "You can use 'cake help -a' to list all tasks, including those without documentation."
   (if-let [names (:help opts)]
     (apply task-doc (map symbol names))
-    (list-all-tasks)))+    (list-all-tasks)))
+
+(deftask version
+  "Print the current project name and version."
+  (println (:artifact-id project) (:version project)))


Computing world-net indexes.

Computing world-net indexes.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -68,8 +68,16 @@
                                    [(:accept-addr stream) (:accept-port stream)]
                                    [(:server-port stream)
                                     (:client-addr stream) (:client-port stream)]] (:msgs stream)))))
-    (let [addrs @addrs
-          h (mapv (fn [[addr addr-v]]
+    (doall (map-indexed
+            (fn [addr-idx [addr addr-v]]
+              (swap! coords #(assoc % addr addr-idx))
+              (doseq [[[accept-addr accept-port] accept-addr-port-v] (sort-by first (:outs addr-v))]
+                (doall (map-indexed
+                        (fn [idx [[from-port to-addr to-port] msgs]]
+                          (swap! coords #(assoc % [addr from-port] idx)))
+                        (sort-by first accept-addr-port-v)))))
+            (sort-by first @addrs)))
+    (let [h (mapv (fn [[addr addr-v]]
                     ["
addr: " addr ""
                      (mapv (fn [[[accept-addr accept-port] accept-addr-port-v]]
                              ["
" accept-addr accept-port
@@ -86,9 +94,9 @@
                               "
"])
                            (sort-by first (:outs addr-v)))
                      "
"])
-                  (sort-by first addrs))]
+                  (sort-by first @addrs))]
       (set-el-innerHTML "net"
-                        (apply str (flatten h))))))
+                        (apply str (flatten [h @coords]))))))

 (defn world-vis-init [el-prefix init-event-delay]
   (let [cmd-inject-ch (chan)


moved into puny

moved into puny

--- src/celestial/redis.clj
+++ src/celestial/redis.clj
@@ -35,7 +35,6 @@
          #_(throw+ {:type ::redis:connection :redis-host (get! :redis :host)} "Redis connection error")
          )))

-
 (defn get- [k] (wcar (car/get k)))

 ; TODO this should be enabled in upstream
@@ -49,13 +48,6 @@
 (defn create-worker [name f]
   (carmine-mq/worker (server-conn) name {:handler f :eoq-backoff-ms 200}))

-(defn missing-keys [rk m]
-  (difference (into #{} (map keyword (car/hkeys rk))) (into #{} (keys m))))
-
-(defn hsetall* [rk m & [missing]]
-  "The reverse action of hgetall*, missing keys will be removed (if provided)."
-    (when missing (wcar (doseq [d missing] (car/hdel rk d))))
-    (apply car/hmset rk (flatten (into [] (map-vals m car/freeze)))) )
-
 (defn clear-all []
   (wcar (car/flushdb)))
+


transform-reads still causing trouble, it needs a knob for a now and
serious revisit later

same as Om 8ce880dc246f12dbb29c3bfa7fb6563a068f939e

--- src/cellophane/next.clj
+++ src/cellophane/next.clj
@@ -699,29 +699,31 @@
    reads have been replaced by the full query for each component that cares about
    the specified read."
   [r tx]
-  (letfn [(with-target [target q]
-            (if-not (nil? target)
-              [(force (first q) target)]
-              q))
-          (add-focused-query [k target tx c]
-            (let [transformed (->> (focus-query (get-query c) [k])
-                                (with-target target)
-                                (full-query c))]
-              (into tx (remove (set tx)) transformed)))]
-    (loop [exprs (seq tx) tx' []]
-      (if-not (nil? exprs)
-        (let [expr (first exprs)
-              ast  (parser/expr->ast expr)
-              key  (:key ast)
-              tgt  (:target ast)]
-          (if (keyword? key)
-            (let [cs (ref->components r key)]
-              (recur (next exprs)
-                (reduce #(add-focused-query key tgt %1 %2)
-                  (cond-> tx'
-                    (empty? cs) (conj expr)) cs)))
-            (recur (next exprs) (conj tx' expr))))
-        tx'))))
+  (if (-> r :config :easy-reads)
+    (letfn [(with-target [target q]
+              (if-not (nil? target)
+                [(force (first q) target)]
+                q))
+            (add-focused-query [k target tx c]
+              (let [transformed (->> (focus-query (get-query c) [k])
+                                  (with-target target)
+                                  (full-query c))]
+                (into tx (remove (set tx)) transformed)))]
+      (loop [exprs (seq tx) tx' []]
+        (if-not (nil? exprs)
+          (let [expr (first exprs)
+                ast  (parser/expr->ast expr)
+                key  (:key ast)
+                tgt  (:target ast)]
+            (if (keyword? key)
+              (let [cs (ref->components r key)]
+                (recur (next exprs)
+                  (reduce #(add-focused-query key tgt %1 %2)
+                    (cond-> tx'
+                      (empty? cs) (conj expr)) cs)))
+              (recur (next exprs) (conj tx' expr))))
+          tx')))
+    tx))

 (defn set-query!
   "Change the query of a component. Takes a map containing :params and/or
@@ -1736,7 +1738,8 @@
            root-render root-unmount
            pathopt
            migrate id-key
-           instrument]
+           instrument
+           easy-reads]
     :or {;ui->props    default-ui->props
          indexer      cellophane.next/indexer
          merge-sends  #(merge-with into %1 %2)
@@ -1750,7 +1753,8 @@
          ;; root-render  #(js/ReactDOM.render %1 %2)
          ;; root-unmount #(js/ReactDOM.unmountComponentAtNode %)
          pathopt      false
-         migrate      default-migrate}
+         migrate      default-migrate
+         easy-reads   true}
     :as config}]
   {:pre [(map? config)]}
   (let [idxr   (indexer)
@@ -1774,7 +1778,8 @@
                   :pathopt pathopt
                   :migrate migrate
                   :id-key id-key
-                  :instrument instrument}
+                  :instrument instrument
+                  :easy-reads easy-reads}
                  (atom {:queue [] :queued false :queued-sends {}
                         :sends-queued false
                         :target nil :root nil :render nil :remove nil


some simplification of DSL

some simplification of DSL

--- test/push/design_spikes/dsl_macros.clj
+++ test/push/design_spikes/dsl_macros.clj
@@ -5,43 +5,52 @@
 ;; This is a design spike. That means it's NOT TO BE USED.
 ;; IT'S A SKETCH.

-;; So I'm thinking about each Push instruction as a
-;; "transaction" involving a single Interpreter passing in and out.
+;; So I'm thinking about each Push instruction as a cascade of individual
+;; atomic transformations, using Clojure's thread-first macro to apply
+;; a sequence of DSL functions.

-;; The DSL for Push instructions could be a series of threaded (->) steps.
+;; The DSL for Push instructions could be a series of simple steps.
 ;; Everything would be assumed to happen inside one interpreter, and the interpreter
-;; (and some kind of local vars) would be passed step-to-step.
-;; - `count-of` would return the number of items of the named stack
-;; + `consume-as` would pop an item from the named stack and assign it to a (local) symbol
-;; - `consume-nth-as` would extract a numbered item from the stack and record it
-;; - `consume-stack-as` would grab the entire list as a single (local) symbol
-;; - `record-as` would save the current top item on the named stack
-;; - `record-nth-as` would save the nth item on the named stack
-;; - `discard` would pop an item from the named stack
-;; - `discard-stack` would empty the named stack
-;; + `send-to` would push the indicated value to that stack
-;;   (using the router and any filters found there)
-;; - `replace-stack` would replace the indicated stack with a new list
+;; (and some store of local scratch vars) would be passed step-to-step.
+;;
+; - `count-of [stackname :as local]`
+;    store the number of items in `stackname` under key `local`
+; - `consume [stackname]`
+;    pop an item (and discard it) from `stackname`
+;    raise an Exception if it's empty or undefined
+; - `consume [stackname :as local]`
+;    pop an item from `stackname` and store under key `local`
+;    raise an Exception if it's empty or undefined
+; - `consume [stackname :at where :as local]`
+;    delete an item from `stackname` at position `where` and store under key `local`
+;    raise an Exception if it's empty or undefined
+; - `consume-stack [stackname]`
+;    clear the named stack
+;    raise an Exception if it's undefined
+; - `consume-stack [stackname :as local]`
+;    save the entire stack into `local` and clear it
+;    raise an Exception if it's undefined
+; - `remember [stackname :as local]`
+;    store top item from `stackname` under key `local`
+;    raise an Exception if it's empty or undefined
+; - `remember [stackname :at where :as local]`
+;    store item in `stackname` at position `where` under key `local`
+;    raise an Exception if it's empty or undefined
+; - `remember-stack [stackname :as local]`
+;    save the entire stack to the `local`
+;    raise an Exception if it's undefined
+; - `place [stackname item]`
+;    push the item to the named stack
+;    raise an Exception if it's undefined
+; - `replace-stack [stackname new-stack]`
+;    replace the indicated stack with a new list
+;    raise an exception if it's undefined

-;; And I THINK that supports all defined Push instructions I've ever seen.
+;; And I THINK that supports all defined Push instructions I've ever seen....

 (def six-ints (make-interpreter :stacks {:integer '(6 5 4 3 2 1)}))

-
-(defn pop-item
-  [interpreter stack]
-  (let [old-stack (get-stack interpreter stack)]
-    (if (empty? old-stack)
-      [interpreter nil]
-      [(set-stack interpreter stack (pop old-stack)) (first old-stack)]
-    )))
-
-
-(fact "pop-item returns a vector of the item (or nil) and the changed interpreter"
-  (first (pop-item six-ints :integer)) => (set-stack six-ints :integer '(5 4 3 2 1))
-  (last  (pop-item six-ints :integer)) => 6
-  )

 (defrecord PushDslState [interpreter locals])

@@ -52,8 +61,8 @@
   ([interpreter locals] (->PushDslState interpreter locals)))

-(defn consume-as
-  [dslstep id stack]
+(defn consume
+  [dslstep stack & {:keys [as]}]
   (let [interpreter (:interpreter dslstep)
         old-stack (get-stack interpreter stack)
         old-locals (:locals dslstep)]
@@ -61,64 +70,43 @@
       (throw (Exception. (str "Push DSL Error: " stack " is empty")))
       (make-PushDslState
         (set-stack interpreter stack (pop old-stack))
-        (assoc old-locals id (first old-stack)))
+        (assoc old-locals as (first old-stack)))
     )))

 (def sixier (make-PushDslState six-ints))

-(fact "consume-as returns a new PushDslState with a changed :interpreter and new locals"
-  (:locals (consume-as sixier :int1 :integer)) => {:int1 6}
-  (get-stack (:interpreter (consume-as sixier :int1 :integer)) :integer) => '(5 4 3 2 1))
+(fact "consume returns a new PushDslState with a changed :interpreter and new locals"
+  (:locals (consume sixier :integer :as :int1)) => {:int1 6}
+  (get-stack (:interpreter (consume sixier :integer :as :int1)) :integer) => '(5 4 3 2 1))

-(fact "consume-as throws an exception if the stack is empty"
-  (:locals (consume-as sixier :nope :boolean)) => (throws #"Push DSL Error:"))
+(fact "consume throws an exception if the stack is empty"
+  (:locals (consume sixier :boolean :as :nope)) => (throws #"Push DSL Error:"))

-(fact "consume-as can be thread-firsted"
-  (let [two-popped (-> sixier
-                      (consume-as :int1 :integer)
-                      (consume-as :int2 :integer))]
+(fact "consume can be thread-firsted"
+  (let [two-popped (->  sixier
+                        (consume :integer :as :int1)
+                        (consume :integer :as :int2))]
     (:locals two-popped) => {:int1 6, :int2 5}
     (get-stack (:interpreter two-popped) :integer) => '(4 3 2 1)))

-(defn send-to
+(defn place
   [dslstep stack args function]
   (let [result (apply function (map (:locals dslstep) args))
         interpreter (:interpreter dslstep)]
     (assoc dslstep :interpreter (push-item interpreter stack result))))

-(fact "`send-to` will apply the specified inline function to the dslstate locals named"
-  (let [added (-> sixier
-                    (consume-as :int1 :integer)
-                    (consume-as :int2 :integer)
-                    (send-to :integer [:int1 :int2] #(+ %1 %2)))]
-  (get-stack (:interpreter added) :integer) => '(11 4 3 2 1)))
-
-;; now there's another possibility that strikes me:
-;; we could use a syntax like (consume % :integer :as :int1)
-;; and that would permit      (consume % :integer)
-;; which might put the consumed item in a little vector stack
-;;
-;; why?
-;; because then integer-add might be
-;;   -> interpreter
-;;      (consume :integer)
-;;      (consume :integer)
-;;      #(+ %1 %2)           (which would use the stack as args)
-;; but that might be much harder to read :/
-
-
-;; a simpler version yet (using an invisible stack inside the Interpreter itself, maybe?):
-;; (grab :integer)
-;; (grab :integer)
-;; (place :integer #(+ %1 %2))
-
-
+(fact "`place` will apply the specified inline function to the dslstate locals named"
+  (let [integer-add (-> sixier
+                        (consume :integer :as :int1)
+                        (consume :integer :as :int2)
+                        (place :integer [:int1 :int2] #(+ %1 %2)))]
+  (get-stack (:interpreter integer-add) :integer) => '(11 4 3 2 1))) ;;

 ; (def-pushinstruction
@@ -127,23 +115,11 @@
 ;   :needs {:integer 2}
 ;   :makes {:integer 1}
 ;   :tags [:arithmetic :core]
-;     (consume-as :int1 :integer)
-;     (consume-as :int2 :integer)
-;     (send-to :integer [:int1 :int2] %(+ %1 %2))
+;     (consume :integer :as :int1)
+;     (consume :integer :as :int2)
+;     (place :integer [:int1 :int2] %(+ %1 %2))
 ;     )

-
-; ;; expands to a function something like
-
-; (defn integer_add
-;   "adds two :integers"
-;   [interpreter]
-;   (-> interpreter
-;     (consume-as int1 :integer)
-;     (consume-as int2 :integer)
-;     (send-to :integer (+ int1 int2))))
-
-; ;;

 ; (def-pushinstruction
 ;   boolean-flush
@@ -151,16 +127,8 @@
 ;   :needs {:boolean 0}
 ;   :tags [:combinator :core]
 ;   :transaction
-;     (discard-stack :boolean)
+;     (consume-stack :boolean)
 ;     )
-
-; ;; expands to a function something like
-
-; (defn boolean_flush
-;   "empties the :boolean stack"
-;   [interpreter]
-;   (-> interpreter (discard-stack :boolean))
-;   )

 ; (def-pushinstruction
@@ -169,9 +137,11 @@
 ;   :needs {:integer 1 :float 1}
 ;   :tags [:core :combinator]
 ;   :transaction
-;     (consume-as int1 :integer)
-;     (record-nth-as float1 :float (mod int1 (count-of :float)))
-;     (send-to :float float1)]
+;     (consume :integer :as :int1)
+;     (count-of :float :as :how-many)
+;     ????? this one's not so obvious yet
+;     (remember :float :at (mod int1 ) :as :float1)
+;     (place :float float1)]
 ;     )


RS + CW | 16 | Redirects now go to https

--- test/stonecutter_journey_test/test.clj
+++ test/stonecutter_journey_test/test.clj
@@ -33,7 +33,7 @@
    (after :contents (do (wd/quit)))]

   (fact "can go to client page"
-        (wd/to "http://stonecutter-client.herokuapp.com")
+        (wd/to "https://stonecutter-client.herokuapp.com")
         (wait-for-title "Home")
         (screenshot "client_home_page")
-        (wd/current-url) => "http://stonecutter-client.herokuapp.com/login"))
+        (wd/current-url) => "https://stonecutter-client.herokuapp.com/login"))


Extend goog-dependencies* to match double-quoutes on first argument

When using a closure compiler generated goog/deps.clj, goog-dependencies* fails
to parse anything from the file.  This is due to the compiler writing the
dependencies using double quotes for the first argument to  addDepenendency.

Signed-off-by: Brenton Ashworth <1d17d9de8cdc4334ed2cad585a02d8c1d3605456@gmail.com>

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -396,7 +396,7 @@
                             (-> (.substring s 1 (dec (count s)))
                                 (string/split #"'\s*,\s*'"))))]
     (->> (line-seq (io/reader (io/resource "goog/deps.js")))
-         (map #(re-matches #"^goog\.addDependency\('(.*)',\s*\[(.*)\],\s*\[(.*)\]\);.*" %))
+         (map #(re-matches #"^goog\.addDependency\(['\"](.*)['\"],\s*\[(.*)\],\s*\[(.*)\]\);.*" %))
          (remove nil?)
          (map #(drop 1 %))
          (remove #(.startsWith (first %) "../../third_party"))


add `cljs.closure/sort-modules` using `util/topo-sort`

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -626,6 +626,29 @@
      {:output-to "out/modules/reader.js"
       :entries '#{cljs.reader}
       :depends-on #{:core}}})
+  )
+
+(defn sort-modules [modules-with-base]
+  (letfn [(get-deps [module]
+            (reduce
+              (fn [ret [name {:keys [depends-on] :as module-desc}]]
+                (cond-> ret
+                  (contains? depends-on module) (conj name)))
+              [] modules-with-base))]
+    (vec (map (fn [module-name]
+                [module-name (module-name modules-with-base)])
+           (into [:cljs-base] (util/topo-sort :cljs-base get-deps))))))
+
+(comment
+  (sort-modules
+    (add-cljs-base-module
+      {:core
+       {:output-to "out/modules/core.js"
+        :entries   '#{cljs.core}}
+       :landing
+       {:output-to  "out/modules/reader.js"
+        :entries    '#{cljs.reader}
+        :depends-on #{:core}}}))
   )

 (defn build-modules [sources opts]


Some typos and cleanup

Some typos and cleanup

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -1,9 +1,7 @@
 (ns clj-spotify.core
   (:require [clj-http.client :as client]
             [clojure.data.json :as json]
-            [clojure.string :as string]
-            )
-  )
+            [clojure.string :as string]))

 (def template-keys [:id :category_id :owner_id :playlist_id :user_id])

@@ -15,24 +13,29 @@
   (json/read-str s :key-fn keyword))

 (defn response-to-map
-  "Parse body of http respose to json"
+  "Parse body of http response to json"
   [response]
   (with-meta
     (try
       (json-string-to-map (:body response))
-      (catch java.lang.NullPointerException e {:error {:status "NullPointerException"  :message (.getMessage e)}})
-      (catch Exception e {:error {:status "Exception"  :message (.getMessage e)}})
-      ) {:status (:status response)}))
+      (catch java.lang.NullPointerException e
+        {:error {:status "NullPointerException"
+                 :message (.getMessage e)}})
+      (catch Exception e
+        {:error {:status "Exception"
+                 :message (.getMessage e)}}))
+    {:status (:status response)}))

 (defn- build-new-url
-  "Do the building nescessary in replace-url-values here. url-parts is the split up url which values works as keys in param-map."
+  "Do the building necessary in replace-url-values here. url-parts is the split up url which values works as keys in param-map."
   [url url-parts param-map]
   (if (empty? url-parts)
     (str "https:/" url)
     (let [url-key (keyword (last url-parts))
           new-url (str "/" (if (contains? param-map url-key)
                              (url-key param-map)
-                             (last url-parts))  url)]
+                             (last url-parts))
+                       url)]
       (recur new-url (pop url-parts) param-map))))

 (defn replace-url-values
@@ -40,22 +43,27 @@
   [param-map url]
   (if (string/blank? url)
     ""
-    (let [act-tmplt-keys  (select-keys param-map template-keys)
-          split-url (string/split (string/replace url "https://" "") #"/")
-          ]
+    (let [act-tmplt-keys (select-keys param-map template-keys)
+          split-url (string/split (string/replace url "https://" "") #"/")]
       (build-new-url "" split-url act-tmplt-keys))))

 (defn comma-separate
   "If v is a sequence, convert to a comma separated string."
-  [k v]
+  [v]
   (if (or (seq? v) (vector? v))
-    [k (string/join "," v)]
-    [k v]))
+    (string/join "," v)
+    v))
+
+(defn- map-vals
+  "Applies f to each value in m."
+  [f m]
+  (zipmap (keys m)
+          (map f (vals m))))

 (defn convert-values
   "Convert values in query-params to match spotifys api."
   [m]
-  (into {} (for [[k v] m] (comma-separate k v))))
+  (map-vals comma-separate m))

 (defn remove-path-keys
   "Remove keys that are used in modifying the path."
@@ -63,21 +71,19 @@
   (apply dissoc m template-keys))

 (defn modify-form-params
-  "Do nescessary conversion of form parameters."
+  "Do necessary conversion of form parameters."
   [m]
-  (->
-    m
-    (remove-path-keys)
-    (convert-values)))
+  (-> m
+      remove-path-keys
+      convert-values))

 (defn select-params-type
   "Return either :query-params or :form-params key depending on value of verb"
   [verb]
-
-    (if
-      (or (= verb client/put) (= verb client/post))
-      :form-params
-      :query-params))
+  (if
+    (or (= verb client/put) (= verb client/post))
+    :form-params
+    :query-params))

 (defn spotify-api-call
   "Returns a function that takes a map m and an optional oauth-token t as arguments."


Refactor bam reader

Refactor bam reader

--- src/cljam/bam/reader.clj
+++ src/cljam/bam/reader.clj
@@ -1,103 +1,23 @@
 (ns cljam.bam.reader
-  (:use [cljam.io])
-  (:require [clojure.string :refer [join]]
-            [clojure.java.io :refer [file]]
-            (cljam [lsb :as lsb]
-                   [util :refer [string->bytes ubyte hex-string->bytes]])
-            [cljam.util.sam-util :refer [phred->fastq ref-id ref-name
-                                         compressed-bases->chars
-                                         parse-header get-end]]
+  (:require [cljam.lsb :as lsb]
+            [cljam.util.sam-util :refer [ref-id ref-name parse-header get-end]]
             [cljam.bam-index :refer [get-spans]]
             [cljam.bam.common :refer [fixed-block-size]]
             [cljam.bam.decoder :as decoder])
-  (:import java.util.Arrays
-           [java.io DataInputStream Closeable EOFException]
-           [java.nio ByteBuffer ByteOrder]
-           [bgzf4j BGZFInputStream]))
+  (:import [java.io Closeable EOFException]
+           java.nio.ByteBuffer
+           bgzf4j.BGZFInputStream))

-;;
 ;; BAMReader
-;;
+;; ---------

 (deftype BAMReader [f header refs reader data-reader index]
   Closeable
   (close [this]
     (.close ^Closeable (.reader this))))

-;;
-;; read alignment
-;;
-
-(defn- read-alignment [^BAMReader bam-reader refs]
-  (let [rdr (.data-reader bam-reader)
-        block-size (lsb/read-int rdr)]
-    (when (< block-size fixed-block-size)
-      (throw (Exception. (str "Invalid block size: " block-size))))
-    (let [buffer ^ByteBuffer (ByteBuffer/allocate block-size)]
-      (lsb/read-bytes rdr (.array buffer) 0 block-size)
-      (let [ref-id      (lsb/read-int buffer)
-            rname       (if (= ref-id -1) "*" (:name (nth refs ref-id)))
-            pos         (inc (lsb/read-int buffer))
-            l-read-name (int (lsb/read-ubyte buffer))
-            mapq        (lsb/read-ubyte buffer)
-            bin         (lsb/read-ushort buffer)
-            n-cigar-op  (lsb/read-ushort buffer)
-            flag        (lsb/read-ushort buffer)
-            l-seq       (lsb/read-int buffer)
-            rnext       (decoder/decode-next-ref-id refs (lsb/read-int buffer) rname)
-            pnext       (inc (lsb/read-int buffer))
-            tlen        (lsb/read-int buffer)
-            qname       (lsb/read-string buffer (dec l-read-name))
-            _           (lsb/skip buffer 1)
-            cigar       (decoder/decode-cigar (lsb/read-bytes buffer (* n-cigar-op 4)))
-            seq         (decoder/decode-seq (lsb/read-bytes buffer (/ (inc l-seq) 2)) l-seq)
-            qual        (decoder/decode-qual (lsb/read-bytes buffer l-seq))
-            rest        (lsb/read-bytes buffer (decoder/options-size block-size
-                                                                     l-read-name
-                                                                     n-cigar-op
-                                                                     l-seq))
-            options     (decoder/decode-options rest)]
-        {:qname qname, :flag flag, :rname rname, :pos pos, :mapq  mapq,
-         :cigar cigar, :rnext rnext, :pnext pnext, :tlen tlen, :seq seq,
-         :qual qual, :options options}))))
-
-(defn- light-read-alignment [^BAMReader bam-reader refs]
-  (let [rdr (.data-reader bam-reader)
-        block-size (lsb/read-int rdr)]
-    (when (< block-size fixed-block-size)
-      (throw (Exception. (str "Invalid block size: " block-size))))
-    (let [buffer ^ByteBuffer (ByteBuffer/allocate block-size)]
-      (lsb/read-bytes rdr (.array buffer) 0 block-size)
-      (let [ref-id      (lsb/read-int buffer)
-            rname       (or (ref-name refs ref-id) "*")
-            pos         (inc (lsb/read-int buffer))
-            l-read-name (int (lsb/read-ubyte buffer))
-            _           (lsb/skip buffer 3)
-            n-cigar-op  (lsb/read-ushort buffer)
-            _           (lsb/skip buffer (+ 18 l-read-name))
-            cigar-bytes (lsb/read-bytes buffer (* n-cigar-op 4))]
-        {:rname rname, :pos pos, :meta {:cigar-bytes cigar-bytes}}))))
-
-(defn- pointer-read-alignment [^BAMReader bam-reader refs]
-  (let [rdr (.data-reader bam-reader)
-        pointer-beg (.getFilePointer ^BGZFInputStream (.reader bam-reader))
-        block-size (lsb/read-int rdr)]
-    (when (< block-size fixed-block-size)
-      (throw (Exception. (str "Invalid block size: " block-size))))
-    (let [buffer ^ByteBuffer (ByteBuffer/allocate block-size)]
-      (lsb/read-bytes rdr (.array buffer) 0 block-size)
-      (let [ref-id      (lsb/read-int buffer)
-            rname       (if (= ref-id -1) "*" (ref-name refs ref-id))
-            pos         (inc (lsb/read-int buffer))
-            l-read-name (int (lsb/read-ubyte buffer))
-            _           (lsb/skip buffer 3)
-            n-cigar-op  (lsb/read-ushort buffer)
-            flag        (lsb/read-ushort buffer)
-            _           (lsb/skip buffer (+ 16 l-read-name))
-            cigar       (decoder/decode-cigar (lsb/read-bytes buffer (* n-cigar-op 4)))
-            pointer-end (.getFilePointer ^BGZFInputStream (.reader bam-reader))]
-        {:flag flag, :rname rname, :pos pos,:cigar cigar,
-         :meta {:chunk {:beg pointer-beg, :end pointer-end}}}))))
+;; Reading a single block
+;; --------------------

 (defn- read-alignment-block
   "Reads an alignment block, returning a map including the block size and the
@@ -144,6 +64,34 @@
     {:data (lsb/read-bytes rdr block-size)
      :pointer-beg pointer-beg
      :pointer-end (.getFilePointer ^BGZFInputStream (.reader bam-reader))}))
+
+;; Reading a single alignment
+;; --------------------------
+
+(defn- read-alignment
+  "Reads a single alignment and decodes it entirely, returning a map including
+  full information. See also `cljam.bam.decoder/deep-decode-alignment-block`."
+  [bam-reader refs]
+  (-> (read-alignment-block bam-reader refs)
+      (decoder/deep-decode-alignment-block refs)))
+
+(defn- light-read-alignment
+  "Reads a single alignment and decodes it partialy, returning a map including
+  partial information. See also
+ `cljam.bam.decoder/light-decode-alignment-block`."
+  [bam-reader refs]
+  (-> (read-alignment-block bam-reader refs)
+      (decoder/light-decode-alignment-block refs)))
+
+(defn- pointer-read-alignment
+  "Reads a single alignment and decodes it partialy, returning a map including
+  partial information and file pointers. See also
+ `cljam.bam.decoder/pointer-decode-alignment-block`."
+  [bam-reader refs]
+  (-> (read-pointer-alignment-block bam-reader refs)
+      (decoder/pointer-decode-alignment-block refs)))
+
+;;

 (defn- read-to-finish
   [^BAMReader rdr


Go friedlier escapes.

Go friedlier escapes.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -342,8 +342,7 @@
 (defmethod emit-constant Boolean [x] (emits (if x "true" "false")))
 (defmethod emit-constant Character [x]
   (emits (wrap-in-double-quotes (case x
-                                  \' "\\'"
-                                  \" "\""
+                                  \" "\\\""
                                   (escape-char x)))))

 (defmethod emit-constant java.util.regex.Pattern [x]


Reflect the transition of transform-attributes

--- src/clojure/neko/doc.clj
+++ src/clojure/neko/doc.clj
@@ -12,8 +12,7 @@
 (ns neko.doc
   "This namespace contains functions that help the developer with
   documentation for different parts of neko. "
-  (:require [neko.ui :as ui]
-            [neko.ui.traits :as traits]
+  (:require [neko.ui.traits :as traits]
             [neko.ui.mapping :as mapping])
   (:use [clojure.string :only [join]]))

@@ -38,7 +37,7 @@
                        (pr-str values))))))

 (defn- get-trait-doc [trait]
-  (when-let [doc (get-in (meta #'ui/transform-attributes)
+  (when-let [doc (get-in (meta #'traits/transform-attributes)
                             [:trait-doc trait])]
     (str trait " - " doc)))


Modified handler.clj.

Modified handler.clj.

--- src/cloprand/handler.clj
+++ src/cloprand/handler.clj
@@ -39,6 +39,12 @@
        :identifiers clojure.string/lower-case
        :as-arrays? true)))

+(defn get_tabcontents
+  "Get selected tab contents by tab ID."
+  [tab_id]
+  (if (= tab_id "management")
+      { :label "管理" }
+      { :label (format "'%s'はまだ用意されていません <(_ _)>", tab_id) }))

 (defroutes app-routes
   (POST "/create_table" [table_name]
@@ -49,6 +55,8 @@
     (response {:value table_name}))
   (POST "/get_tables" []
     (response {:value (get_tables)}))
+  (POST "/get_tabcontents" [tab_id]
+    (response (get_tabcontents tab_id)))
   (route/files "/")
   (route/resources "/")
   (route/not-found "Not Found"))


remove modifed params because it seems to break communication with frontend by causing params to always be empty

--- src/clj/ohds/server.clj
+++ src/clj/ohds/server.clj
@@ -55,11 +55,9 @@
   (GET "/*" req (page)))

 (def http-handler
-  (let [config (assoc api-defaults :params {:nested true
-                                            :keywordize true})]
-    (if is-dev?
-      (reload/wrap-reload (wrap-defaults #'routes config))
-      (wrap-defaults routes config))))
+  (if is-dev?
+    (reload/wrap-reload (wrap-defaults #'routes api-defaults))
+    (wrap-defaults routes api-defaults)))

 (defn run-web-server [& [port]]
   (let [port (Integer. (or port (env :port) 10555))]


minor declare spring cleaning

minor declare spring cleaning

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -90,8 +90,6 @@
   function *main-fn* is set to will be called with the command-line
   argv as arguments"}
   *main-cli-fn* nil)
-
-(declare pr-str chunk-first chunk-rest)

 (defn type [x]
   (when-not (nil? x)
@@ -607,7 +605,7 @@
                (recur nval (inc n))))
            val)))))

-(declare hash-coll cons pr-str RSeq)
+(declare hash-coll cons RSeq)

 (defn ^boolean counted?
   "Returns true if coll implements count in constant time"
@@ -1753,7 +1751,7 @@
                (next s)))
       h)))

-(declare name)
+(declare name chunk-first chunk-rest)

 (defn- extend-object!
   "Takes a JavaScript object and a map of names to functions and


formatting

formatting

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -4060,23 +4060,19 @@
       (cond
         (== idx -1)
         (if (< cnt cljs.core.PersistentArrayMap/HASHMAP_THRESHOLD)
-          (PersistentArrayMap. meta
-                               (inc cnt)
-                               (array-map-extend-kv coll k v)
-                               nil)
-          (-with-meta
-            (-assoc (into cljs.core.PersistentHashMap/EMPTY coll) k v)
-            meta))
+          (let [arr (array-map-extend-kv coll k v)]
+            (PersistentArrayMap. meta (inc cnt) arr nil))
+          (-> (into cljs.core.PersistentHashMap/EMPTY coll)
+            (-assoc k v)
+            (-with-meta meta)))

         (identical? v (aget arr (inc idx)))
         coll

         :else
-        (PersistentArrayMap. meta
-                             cnt
-                             (doto (aclone arr)
-                               (aset (inc idx) v))
-                             nil))))
+        (let [arr (doto (aclone arr)
+                    (aset (inc idx) v))]
+          (PersistentArrayMap. meta cnt arr nil)))))

   (-contains-key? [coll k]
     (not (== (array-map-index-of coll k) -1)))


cache player sprites

cache player sprites

--- src/cljs/mpd/stage.cljs
+++ src/cljs/mpd/stage.cljs
@@ -16,20 +16,30 @@
 (def enemySprite
   (pukeSprite "images/enemy.png"))

-(defmulti pixi (fn [x y] x))
-(defmethod pixi :player [_ state]
-  (let [fill (case [(:primary state) (:secondary state)]
+(def player-sprites (atom {}))
+(defn player-sprite [player]
+  (let [exists (get @player-sprites (:id player))]
+    (if (nil? exists)
+      (let [fill (case [(:primary player) (:secondary player)]
                [true true] "green"
                [true false] "red"
                [false true] "blue"
                "green")
-        obj (js/PIXI.Text.
-              (str (:id state))
+            sprite (js/PIXI.Text.
+              (str (:id player))
               (js-obj "fill" fill))]
-    (aset obj "anchor" (js-obj "x" 0.5 "y" 0.5))
-    (aset obj "position" (js-obj "x" (:x state) "y" (:y state)))
-    (aset obj "rotation" (:rotation state))
-    [obj]))
+        (log "creating sprite for " (:id player))
+        (swap! player-sprites assoc (:id player) sprite)
+        sprite)
+      exists)))
+
+(defmulti pixi (fn [x y] x))
+(defmethod pixi :player [_ state]
+  (let [player (player-sprite state)]
+    (aset player "anchor" (js-obj "x" 0.5 "y" 0.5))
+    (aset player "position" (js-obj "x" (:x state) "y" (:y state)))
+    (aset player "rotation" (:rotation state))
+    [player]))

 (defmethod pixi :enemies [_ enemies]
   (reduce (fn [agg enemy]
@@ -53,19 +63,21 @@
   (aset crosshairSprite "position" (js-obj "x" (:x crosshair) "y" (:y crosshair)))
   [crosshairSprite])

-(def world (js/PIXI.Container.))
-(def background_sprite
-  (let [bg_sprite (PIXI.extras.TilingSprite.fromImage "images/floor.png" 10000 10000)]
-    (aset bg_sprite "scale" (js-obj "x" 0.5 "y" 0.5))
-    bg_sprite))
+(def root (let [c (js/PIXI.Container.)
+                bg (PIXI.extras.TilingSprite.fromImage "images/floor.png" 5000 5000)]
+  (aset bg "scale" (js-obj "x" 0.5 "y" 0.5))
+  (.addChild c bg) c))
+(def world (let [c (js/PIXI.Container.)] (.addChild root c) c))
+(def players (let [c (js/PIXI.Container.)] (.addChild root c) c))

 (defn state-to-pixi [state]
   (.removeChildren world)
-  (.addChild world background_sprite)
+  (.removeChildren players)
   (doseq [kv @state]
     (doseq [obj (apply pixi kv)]
-      (.addChild world obj)))
-  world)
+      (let [container (case (first kv) :player players world)]
+        (.addChild container obj))))
+  root)

 (defn setup []
   (log "  stage")


CMR-6040: Minor cleanup.

CMR-6040: Minor cleanup.

--- indexer-app/src/cmr/indexer/data/concepts/service.clj
+++ indexer-app/src/cmr/indexer/data/concepts/service.clj
@@ -73,7 +73,7 @@
         input-formats (distinct (get-in service [:ServiceOptions :SupportedInputFormats]))
         output-formats (distinct (get-in service [:ServiceOptions :SupportedOutputFormats]))]
     (not (or (= (count output-formats) 0)
-             (and (= (count input-formats) (count output-formats) 1)
+             (and (= (count output-formats) 1)
                   (= input-formats output-formats))))))

 (defn- has-subset-type?


Add "I remember this button" to term

Add "I remember this button" to term

--- src/teach_by_friends/shared/scenes/new_design.cljs
+++ src/teach_by_friends/shared/scenes/new_design.cljs
@@ -30,17 +30,17 @@
                         :padding-right    15
                         }}
        [ui/text-input {:auto-capitalize "none"
-                       :style {:color  "rgb(72, 86, 155)"
-                               :height 30}
-                       :on-change-text #(dispatch [:change-search-predicate %])}]]]
+                       :style           {:color  "rgb(72, 86, 155)"
+                                         :height 30}
+                       :on-change-text  #(dispatch [:change-search-predicate %])}]]]
      [ui/view {:style {:flex        5
                        :align-items "center"}}
       [ui/text {:style {:color     "white"
                         :font-size 30}}
        (string/upper-case
          (str "season " title))]])
-   [ui/touchable-opacity {:style {:flex        1
-                                  :align-items "center"}
+   [ui/touchable-opacity {:style    {:flex        1
+                                     :align-items "center"}
                           :on-press #(dispatch [:toggle-search])}
     [search-icon {:style {:width 15 :height 15}}]]])

@@ -117,16 +117,25 @@
          [activity-indicator {:color "white"}]]]
        [ui/view {:style {:border-radius    15
                          :background-color "rgb(132, 145, 206)"
-                         :padding-top      15
-                         :padding-bottom   15
-                         :padding-left     15
-                         :padding-right    15
                          :flex-direction   "column"
                          :align-items      "stretch"
                          }}
-        [ui/text {:style {:font-size 20 :color "white" :margin-bottom 10}} term]
-        [ui/text {:style {:font-size 20 :color "white" :margin-bottom 10}} (first (:translate translate))]
-        [sentence-with-term {} (:sentence translate) (:raw translate)]]
+        [ui/view {:style {:margin-top   15
+                          :margin-left  15
+                          :margin-right 15
+                          }}
+         [ui/text {:style {:font-size 20 :color "white" :margin-bottom 10}} term]
+         [ui/text {:style {:font-size 20 :color "white" :margin-bottom 10}} (first (:translate translate))]
+         [sentence-with-term {:style {:margin-bottom 10}} (:sentence translate) (:raw translate)]]
+        [ui/touchable-opacity {:style    {:background-color           "rgb(72, 86, 155)"
+                                          :justify-content            "center"
+                                          :align-items                "center"
+                                          :border-bottom-left-radius  15
+                                          :border-bottom-right-radius 15
+                                          :padding-top                10
+                                          :padding-bottom             10}
+                               :on-press #(dispatch [:add-to-well-known term])}
+         [ui/text {:style {:color "white"}} "I remember this"]]]
        )]
     [ui/touchable-opacity {:style    {:border-bottom-width 1
                                       :border-color        "rgba(0,0,0,.1)"


Use the built in autoconf

Use the built in autoconf

--- config/software/ruby.clj
+++ config/software/ruby.clj
@@ -34,7 +34,7 @@
             :source "ruby-1.9.2-p180"
             :steps [
                     {:env env
-                     :command "autoconf"
+                     :command "/opt/opscode/embedded/bin/autoconf"
                      }
                     {:env env
                      :command "./configure"


Remove cruft.

Remove cruft.

--- src/defragment/core.clj
+++ src/defragment/core.clj
@@ -5,7 +5,6 @@
             [me.raynes.conch.low-level :as sh]
             [utilza.repl :as urepl]
             [clojure.tools.trace :as trace]
-            [clojure.string :as s]
             [useful.map :as um]
             [utilza.java :as ujava]
             [clojure.edn :as edn]
@@ -49,7 +48,7 @@

 (defn unogg
   "Strip the .suffix from a string.
-   Can not handle . in the name!"
+   WARNING: Can not handle . in the name!"
   [s]
   (-> s
       (st/split  #"\.")
@@ -191,7 +190,7 @@
     "Takes array of CommentFields and translates to a proper Clojure vector"
     [hs]
     (for [^CommentField h hs]
-      [(-> h .name s/lower-case keyword) (.value h)]))
+      [(-> h .name st/lower-case keyword) (.value h)]))

 (defn album-mover
@@ -229,8 +228,8 @@
   (let [n (.name f)
         v (.value f)]
     (and (= "TITLE" n)
-         (or (= "Unknown" (s/trim v))
-             (= "%Y-%m-%d" (s/trim v))
+         (or (= "Unknown" (st/trim v))
+             (= "%Y-%m-%d" (st/trim v))
              (empty? v)))))


Execute the commands directly from within defragment.

--- src/defragment/core.clj
+++ src/defragment/core.clj
@@ -1,7 +1,8 @@
 (ns defragment.core
   (:gen-class)
   (:import java.io.SequenceInputStream)
-  (:require [me.raynes.conch :refer [programs with-programs let-programs] :as sh]
+  (:require [me.raynes.conch :refer [programs with-programs let-programs] :as csh]
+            [me.raynes.conch.low-level :as sh]
             [utilza.repl :as urepl]
             [clojure.tools.trace :as trace]
             [useful.map :as um]
@@ -31,7 +32,7 @@

-(programs vorbiscomment ogginfo oggz-info)
+(programs bash)

 (defn get-oggs
@@ -157,17 +158,21 @@
   (format "%s/%s-%s.ogg"  path date name))

+(defn gen-command-line
+  "Takes a file glob, returns the string command to process it"
+  [cmd-path path {:keys [name date filenames]}]
+  (let [cmd (format "cat %s | %s > %s"
+                    (umisc/inter-str " " filenames)
+                    cmd-path
+                    (format-show-save path name date))]
+    (format "echo \"%s\"\n%s\n" cmd cmd)))
+

 (defn gen-filenames
   [cmd-path path files]
-  (umisc/inter-str "\n"
-                   (for [{:keys [name date filenames]}  files]
-                     (let [cmd (format "cat %s | %s > %s"
-                                       (umisc/inter-str " " filenames)
-                                       cmd-path
-                                       (format-show-save path name date))]
-                       (format "echo \"%s\"\n%s\n" cmd cmd)))))
-
+  (umisc/inter-str "\n" (map (partial gen-command-line cmd-path path)  files)))
+
+

@@ -179,6 +184,23 @@
     (glom-show show-files)))

+(defn execute!
+  [cmd-path path out-commands-file fileglob]
+  (spit out-commands-file (gen-command-line cmd-path path fileglob))
+  (let [{:keys [stdout stderr exit-code]} (bash out-commands-file {:verbose true})]
+    (log/debug {:doing stdout, :result stderr, :status @exit-code})
+    (when (not= 0 @exit-code)
+      ;; TODO: throw exception too?
+      (log/error {:doing stdout, :result stderr, :status @exit-code})))
+  ;; TODO: the post processing!
+  )
+
+
+(defn execute-all!
+  [cmd-path path out-commands-file files]
+  (doseq [f files]
+    (log/info f)
+    (execute! cmd-path path out-commands-file f)))

 (defn prepare-all
@@ -193,8 +215,8 @@
        get-oggs
        (map parse)
        prepare-all
-       (gen-filenames cmd-path out-oggs-path)
-       (spit out-commands-file)))
+       (execute-all! cmd-path out-oggs-path out-commands-file)))
+

@@ -224,7 +246,6 @@
 (comment

   (-main "resources/test-config.edn")
-

   )


Added random command and debug commands

Added random command and debug commands

--- src/demogorgon/core.clj
+++ src/demogorgon/core.clj
@@ -1,5 +1,6 @@
 (ns demogorgon.core
-  (:import [org.apache.log4j Logger])
+  (:import [org.apache.log4j Logger]
+           [java.util Random])
   (:require [swank.swank :as swank])
   (:require [tachyon.core :as irc])
   (:require [tachyon.hooks :as irc-hooks])
@@ -10,15 +11,46 @@
         [demogorgon.nh :only (online-players-hook last-dump-hook nh-start nh-init nh-stop)])
   (:gen-class))

+(def logger (Logger/getLogger "demogorgon.core"))
 (def *connection* (irc/create (:irc config)))
 (def *nh* (nh-init *connection*))
 (def *web* (ref nil))
+;(nh-stop *nh*)

+(defn get-memory-info []
+  (let [runtime (Runtime/getRuntime)
+        total (int (/ (.totalMemory runtime) 1048576))
+        free (int (/ (.freeMemory runtime) 1048576))
+        max (int (/ (.maxMemory runtime) 1048576))
+        used (- total free)]
+    (str "used " used " free " free " total " total " max " max)))
+
+(defn print-debug []
+  (let [thread (:thread @*nh*)]
+    (.debug logger (str (.getName thread) ": " (.getState thread))))
+  (.debug logger (str "before " (get-memory-info)))
+  (.gc (Runtime/getRuntime))
+  (.debug logger (str "after  " (get-memory-info))))
+
+(defn rand-hook [irc object match]
+  (let [words (.split (second match) " ")
+        random (Random.)
+        idx (.nextInt random (alength words))
+        word (aget words idx)]
+    word))
+
+;(print-debug)
 (defn -main[& args]
   (try
    (let [logger (Logger/getLogger "main")]
      (swank/start-repl 4006)
      (nh-start *nh*)
+
+     (irc-hooks/add-message-hook *connection* #"\.rng (.+)" #'rand-hook)
+     (irc-hooks/add-message-hook *connection* #"\.rnd (.+)" #'rand-hook)
+     (irc-hooks/add-message-hook *connection* #"\.random (.+)" #'rand-hook)
+     (irc-hooks/add-message-hook *connection* ".debug" (fn [& rest] (get-memory-info)))
+     (irc-hooks/add-message-hook *connection* ".gc" (fn [& rest] (.gc (Runtime/getRuntime))))
      (irc-hooks/add-message-hook *connection* #"\.u ?(.*)?" #'unicode-hook)
      (irc-hooks/add-message-hook *connection* ".cur" #'online-players-hook)
      (irc-hooks/add-message-hook *connection* ".online" #'online-players-hook)


fixing test

fixing test

--- test/celestial/integration/persistency/actions.clj
+++ test/celestial/integration/persistency/actions.clj
@@ -8,20 +8,18 @@
   [celestial.persistency.actions :as a])
  (:use midje.sweet))

-(def redis-deploy-provided (assoc redis-deploy :provided '()))
-
 (with-conf
   (with-state-changes [(before :facts (re-initlize))]
    (fact "basic actions usage" :integration :redis :actions
      (t/add-type redis-type)
      (let [id (a/add-action redis-deploy)]
-       (a/get-action id) => redis-deploy-provided
+       (a/get-action id) => redis-deploy
        (a/get-action-index :operates-on "redis") => [(str id)]
-       (a/find-action-for "deploy" "redis") =>  redis-deploy-provided))
+       (a/find-action-for "deploy" "redis") =>  redis-deploy))

    (fact "duplicated actions" :integration :redis :actions
      (t/add-type redis-type)
      (let [id (a/add-action redis-deploy)]
-       (a/get-action id) => redis-deploy-provided
+       (a/get-action id) => redis-deploy
        (a/add-action redis-deploy) =>
           (throws ExceptionInfo (is-type? :celestial.persistency.actions/duplicated-action))))))


CMR-5093: Cleanup test.

CMR-5093: Cleanup test.

--- system-int-test/test/cmr/system_int_test/ingest/collection_umm_spec_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_umm_spec_validation_test.clj
@@ -225,41 +225,26 @@
                          :Lines [(umm-cmn/map->LineType
                                    {:Points [(umm-cmn/map->PointType {:Longitude 180 :Latitude 0})
                                              (umm-cmn/map->PointType {:Longitude -180 :Latitude 0})]})]})}]
-        (testing "GranuleSpatialRepresentation enum"
-          (are3 [valid? granule-spatial-representation]
-                (if valid?
-                  (assert-valid-spatial granule-spatial-representation geometry {:format :iso19115})
-                  (assert-invalid-spatial granule-spatial-representation
-                                          geometry
-                                          ["SpatialExtent"]
-                                          [(format "Value (\"%s\") not found in enum (possible values: [\"CARTESIAN\",\"GEODETIC\",\"NO_SPATIAL\",\"ORBIT\"])"
-                                                    granule-spatial-representation)]
-                                          {:format :iso19115}))
-
-                "ISO19115 invalid granule spatial representation"
-                false "INVALID_ISO19115_GRANULE_SPATIAL_REPRESENTATION"
-
-                "ISO19115 valid granule spatial representation"
-                true "GEODETIC"))
-
-        (testing "CoordinateSystem enum"
-          (are3 [valid? coordinate-system]
-                (if valid?
-                  (assert-valid-spatial "CARTESIAN"
-                                        (assoc-in geometry [:Geometry :CoordinateSystem] coordinate-system)
-                                        {:format :iso19115})
-                  (assert-invalid-spatial "CARTESIAN"
-                                          (assoc-in geometry [:Geometry :CoordinateSystem] coordinate-system)
-                                          ["SpatialExtent" "HorizontalSpatialDomain" "Geometry" "CoordinateSystem"]
-                                          [(format "Value (\"%s\") not found in enum (possible values: [\"CARTESIAN\",\"GEODETIC\"])"
-                                                   coordinate-system)]
-                                          {:format :iso19115}))
-
-                "ISO19115 invalid coordinate system"
-                false "INVALID_ISO19115_COORDINATE_SYSTEM"
-
-                "ISO19115 valid coordinate system"
-                true "CARTESIAN"))))
+        (testing "Invalid GranuleSpatialRepresentation enum"
+          (assert-invalid-spatial "INVALID_GRANULE_SPATIAL_REPRESENTATION"
+                                  geometry
+                                  ["SpatialExtent"]
+                                  ["Value (\"INVALID_GRANULE_SPATIAL_REPRESENTATION\") not found in enum (possible values: [\"CARTESIAN\",\"GEODETIC\",\"NO_SPATIAL\",\"ORBIT\"])"]
+                                  {:format :iso19115}))
+        (testing "Valid GranuleSpatialRepresentation enum"
+          (assert-valid-spatial "CARTESIAN"
+                                geometry
+                                {:format :iso19115}))
+        (testing "Invalid CoordinateSystem enum"
+          (assert-invalid-spatial "CARTESIAN"
+                                  (assoc-in geometry [:Geometry :CoordinateSystem] "INVALID_COORDINATE_SYSTEM")
+                                  ["SpatialExtent" "HorizontalSpatialDomain" "Geometry" "CoordinateSystem"]
+                                  ["Value (\"INVALID_COORDINATE_SYSTEM\") not found in enum (possible values: [\"CARTESIAN\",\"GEODETIC\"])"]
+                                  {:format :iso19115}))
+        (testing "Valid CoordinateSystem enum"
+          (assert-valid-spatial "CARTESIAN"
+                                geometry
+                                {:format :iso19115}))))
     (testing "geodetic polygon"
       ;; Invalid points are caught in the schema validation
       (assert-invalid-spatial


Fix require path in test

Fix require path in test

--- test/braid/test/server/db.clj
+++ test/braid/test/server/db.clj
@@ -3,7 +3,7 @@
     [clojure.set :refer [rename-keys]]
     [clojure.test :refer :all]
     [braid.core.server.db :as db]
-    [braid.core.server.db.bot :as bot]
+    [braid.bots.server.db :as bot]
     [braid.core.server.db.group :as group]
     [braid.core.server.db.invitation :as invitation]
     [braid.core.server.db.message :as message]


Fix up the dumb implementation-detail test for multipart

--- test/cljs_rest/core_test.cljs
+++ test/cljs_rest/core_test.cljs
@@ -246,14 +246,15 @@
         (is (= 410 (:status lookup)))
         (done)))))

-; (deftest form-data
-;   (let [form-data (js/FormData.)
-;         opts {:params form-data}
-;         actual (rest/request-options :anything opts)
-;         expected-format rest/multipart-format]
-;     (is (= expected-format (:format actual)))
-;     (is (= form-data (:body actual)))
-;     (is (false? (contains? actual :params)))))
+(deftest multipart-data
+  (let [multipart (rest/MultipartParams {:a "b"})
+        ordered (rest/OrderedMultipartParams [[:a "b"]])
+        actual-multipart (rest/request-options :anything {:params multipart})
+        actual-ordered (rest/request-options :anything {:params ordered})]
+    (is (= (seq multipart) (:multipart-params actual-multipart)))
+    (is (= ordered (:multipart-params actual-ordered)))
+    (is (false? (contains? actual-multipart :params)))
+    (is (false? (contains? actual-ordered :params)))))

 (deftest per-request-error-chan
   (async done


Added the new contracts macro, looks different, but works the same as the old

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -84,78 +84,6 @@
           pre-post-map
           (list* 'f args))))

-(defn build-contract
-  [arity-map]
-  (let [sig (first (keys arity-map))]
-    (list
-     (into '[f] sig)
-     (build-constraints-map (first (vals arity-map)))
-     (list* 'f sig))))
-
-(defn collect-bodies
-  "Where the magic happens.  Takes a list representing the idependent constraints for
-   an unspecified function of the form:
-
-    ([x] :requires (foo x) :ensures (bar %)
-     [x y] :requires (baz x) (quux y) :ensures (blip %))
-
-   Taking this form `collect-bodies` then partitions it in such a way as to identify
-   the arity-based canstraints and pass each on to `build-contract` which then
-   returns the HOF body for each arity.
-  "
-  [arity-maps]
-  (for [amap arity-maps]
-    (build-contract amap)))
-
-
-(defn build-forms-map
-  "Works similarly to the `collect-bodies` function *except* for two differences:
-   1. Recognizes and processes a `:body` element
-   2. Requires that multi-arity functions *must* be enclosed in sublists similar to
-      Clojure's default `fn` form.
-
-   The reason for the former is that the `:body` element refers to the body of the
-   generated function.  Without arity-sepcific body sublists there would be no way to
-   determine when a body ends and another arity constraint specification begins.  This
-   should be no problem since Clojurist are already accustomed to the multi-arity `fn`
-   form.
-
-   This function expects a list of the form:
-
-    ([x] :requires (foo x) (bar n) :ensures (baz %) :body (println x) (frob x))
-
-   or
-
-    (([x] :requires (foo x) :ensures (baz %) :body (frob x))
-     ([x y] :requires (foo x y) :ensures (baz %) :body (frob x y)))
-
-   And will return a map keyed by arity vector of the form:
-
-    {[x] {(:requires) ((foo x)), (:body) ((frob x)), (:ensures) ((baz %))}}
-
-   Which can then be used to build a real function definition by looking up the
-   constraints and body for each arity.
-  "
-  [forms]
-  (for [[[args] & c] (map #(partition-by #{:requires :ensures :body} %)
-                       (if (vector? (first forms))
-                         (list forms)
-                         forms))]
-    {args (let [m (apply array-map c)
-                ks (map first (keys m))
-                vs (vals m)]
-            (zipmap ks (map (fn [k vs]
-                              (map (fn [v]
-                                     (if (symbol? v)
-                                       (cond
-                                        (= k :requires) (apply list v args)
-                                        (= k :ensures)  (apply list v '[%])
-                                        :default        v)
-                                       v))
-                                   vs))
-                            ks
-                            vs)))}))
-
 (defmacro contract
   "The base contract form returning a higher-order function that can then be partially
    applied to an existing function to 'apply' a contract.  Take for example a simple
@@ -164,19 +92,9 @@

     (def doubler-contract
        (contract doubler
-         [x]
-         :requires
-         (number? x)
-
-         :ensures
-         (= (* 2 x) %)
-
-         [x y]
-         :requires
-         (every? number? [x y])
-
-         :ensures
-         (= (* 2 (+ x y)) %)))
+         [x] [number? => (= (* 2 x) %)]
+
+         [x y] [(every? number? [x y]) => (= (* 2 (+ x y)) %)]))

    You can then partially apply this contract with an existing function:

@@ -193,27 +111,23 @@

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

-   While it's fine to use `partial` directly, it's better to use the `with-constraints` macro
+   While it's fine to use `partial` directly, it's better to use the `with-constraints` function
    found in this same library.

    If you're so inclined, you can inspect the terms of the contract via its metadata, keyed on
    the keyword `:constraints`.
   "
-  [& forms]
-  (let [name (when (symbol? (first forms))
-               (first forms))
-        arity-maps (build-forms-map
-                    (map #(mapcat identity %)
-                         (partition 2
-                                    (partition-by
-                                     vector?
-                                     (if name
-                                       (rest forms)
-                                       forms)))))]
+  [name docstring & constraints]
+  (println name docstring constraints)
+  (let [raw-cnstr   (->> (partition-by vector? constraints)
+                         (partition 2))
+        arity-cnstr (for [[[a] c] raw-cnstr]
+                      (build-constraints-map a c))
+        fn-arities  (for [b arity-cnstr]
+                      (build-contract b))]
     (list `with-meta
-          (list* `fn (if name name (gensym))
-                 (collect-bodies arity-maps))
-          `{:constraints (into {} '~arity-maps)})))
+          (list* `fn name fn-arities)
+          `{:constraints (into {} '~arity-cnstr)})))

 (defmacro with-constraints
   "Takes a target function and a number of contracts and returns a function with the contracts


Fix up OOM-catch patch

Fix up OOM-catch patch

--- src/foreclojure/core.clj
+++ src/foreclojure/core.clj
@@ -98,14 +98,19 @@

 (let [default-jetty-port 8080]
   (defn run []
-    (try
-      (do
-        (prepare-mongo)
-        (register-heartbeat)
-        (run-jetty (var app) {:join? *block-server*
-                              :port  (get config :jetty-port default-jetty-port)}))
-      (catch OutOfMemoryError e
-        ;;TODO: log this?
+    (prepare-mongo)
+    (register-heartbeat)
+    (letfn [(run []
+              (run-jetty (var app) {:join? *block-server*
+                                    :port  (get config :jetty-port
+                                                default-jetty-port)}))]
+      (if *block-server*
+        (while true
+          (try
+            (run)
+            (catch OutOfMemoryError _
+              (binding [*out* *err*]
+                (println "Caught error at " (java.util.Date.))))))
         (run)))))

 (defn -main [& args]


refactor code based on lein kibit suggestion

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -228,9 +228,9 @@
                               multiple-select-values
                               (if has-search-expression?
                                 (map #(identity {:name %}) names)
-                                (->> (:children field)
-                                     (filter
-                                      #(contains? names (field-key %)))))]
+                                (filter
+                                 #(contains?
+                                   names (field-key %)) (:children field)))]
                           (->> multiple-select-values
                                (map #(str "☑ " (get-label % language) " "))
                                string/join))


GAWB-1206: This is what happens when you don't think

--- src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
@@ -56,10 +56,10 @@
        :payload new-conf
        :headers utils/content-type=json
        :on-done (fn [{:keys [success? get-parsed-response xhr]}]
-                  (if-not success?
-                    (do (comps/push-error (str "Exception:\n" (.-statusText xhr)))
-                        (swap! state dissoc :blocker))
-                    ((:on-rename props) name)))})))
+                  (swap! state dissoc :blocker)
+                  (if success?
+                    ((:on-rename props) name)
+                    (comps/push-error (str "Exception:\n" (.-statusText xhr)))))})))

 (react/defc MethodDetailsViewer
   {:get-fields


Update persistence.clj

Update persistence.clj

--- src/iyye/persistence.clj
+++ src/iyye/persistence.clj
@@ -57,8 +57,8 @@
 (defn load-days []
   (mongo/get-count iyye-main (str "days_" @iyye-name) {}))

-(defn write-io-to-db [IO input]
-  (let [doc (str "IO")
+(defn write-io-to-db [days IO dir input]
+  (let [doc (str "IO_day_" days)
         dbname (str @iyye-name "_IO_" (:name IO))
-        entry {:time (str (.format (java.text.SimpleDateFormat. "MM_dd_yyyy_HH_mm_ss") (java.util.Date.))) :input input}]
+        entry {:time (str (.format (java.text.SimpleDateFormat. "MM_dd_yyyy_HH_mm_ss") (java.util.Date.))) dir input}]
     (mongo/add-entry dbname doc entry)))


Remove cruft from saha

Remove cruft from saha

--- src/exp/saha_simple.clj
+++ src/exp/saha_simple.clj
@@ -223,53 +223,3 @@
             [(util/make-safe (state-solution root goal)) rew]))))))

-
-(comment ; old stuff from sahucs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Core Algorithm  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-  (declare get-sa-node)
-
-  (defn get-sa-node [#^HashMap cache s a]
-    "Create a new sa-node, or returned the cached copy if it exists."
-    (let [context (env/precondition-context a s)]
-      (util/cache-with cache [(env/action-name a) (env/extract-context s context)]
-                       (let [s     (env/get-logger s context)
-                             prim? (env/primitive? a)
-                             [ss r] (when-let [x (and prim? (env/applicable? a s) (env/successor a s))] x)] ;pun
-                         (SANode  a
-                                  (atom (if ss {(extract-effect ss  [a]) r} {}))
-                                  (make-queue (for [ref (when-not prim? (hierarchy/immediate-refinements a s))]
-                                                [(get-sanode-entry cache s 0.0 ref) 0.0])))))))
-
-
-;; May return states better than next-best, but these will be held at the parent.
-  (defn expand-sa-node [node #^HashMap cache next-best state reward-to-state last-cutoff]
-    (loop [new-results (if (= last-cutoff (cutoff node)) {}
-                           (util/filter-map #(<= (val %) last-cutoff)  @(:result-map-atom node)))]
-      (if (< (cutoff node) next-best)
-        (PartialResult (stitch-effect-map new-results state reward-to-state) (cutoff node))
-        (let [[entry neg-reward] (queues/g-pq-peek-min (:queue node))
-              b-s (:state entry), b-rts (:reward-to-state entry),
-              b-ra (:remaining-actions entry), b-sa (:sanode entry)
-              rec-next-best (- (max next-best (cutoff node)) b-rts)]
-          (if (empty? b-ra)
-            (let [eff (extract-effect b-s (:opt (meta b-s)))]
-              (swap! (:result-map-atom node) assoc-safe >= eff b-rts)
-              (queues/g-pq-remove!  (:queue node) entry)
-              (recur (assoc-safe new-results >= eff b-rts)))
-            (let [rec (expand-sa-node b-sa cache rec-next-best b-s b-rts (- 0 neg-reward b-rts))]
-              (doseq [[ss sr] (:result-map rec)]
-                (queues/g-pq-add! (:queue node) (get-sanode-entry cache ss sr (next b-ra)) (- sr)))
-              (if (> (:cutoff rec) Double/NEGATIVE_INFINITY)
-                (queues/g-pq-replace! (:queue node) entry (- 0 b-rts (:cutoff rec)))
-                (queues/g-pq-remove!  (:queue node) entry))
-              (recur new-results)))))))
-
-
-
-
-
-)


Simplify test

Simplify test

--- test/icecap/e2e/http_test.clj
+++ test/icecap/e2e/http_test.clj
@@ -50,5 +50,5 @@
 (deftest invalid-http-step-tests
   (are [step expected] (let [create-result @(create-cap step)
                              message (bs/to-string (:body create-result))]
-                         (apply = (map pr-str expected)))
+                         (= message expected))
        {:type :http} '{:url missing-required-key}))


indentation

indentation

--- src/greybear/server.clj
+++ src/greybear/server.clj
@@ -17,8 +17,8 @@

 (defn index-page []
   (let [board (first (select games
-                              (where {:id 2})
-                              (limit 1)))]
+                             (where {:id 2})
+                             (limit 1)))]
     (html5
      [:head
       [:title "Grey Bear"]


fix lint error.

fix lint error.

--- src/metabase/metabot.clj
+++ src/metabase/metabot.clj
@@ -57,11 +57,10 @@
   (str "Uh oh! :cry:\n>" (.getMessage e)))

 (defmacro ^:private do-async {:style/indent 0} [& body]
-  `(do (future (try ~@body
-                    (catch Throwable e#
-                      (log/error (u/format-color '~'red (u/filtered-stacktrace e#)))
-                      (slack/post-chat-message! *channel-id* (format-exception e#)))))
-       nil))
+  `(future (try ~@body
+                (catch Throwable e#
+                  (log/error (u/format-color '~'red (u/filtered-stacktrace e#)))
+                  (slack/post-chat-message! *channel-id* (format-exception e#))))))

 (defn- format-cards
   "Format a sequence of Cards as a nice multiline list for use in responses."


Make kibit and Eastwood happy.

Make kibit and Eastwood happy.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -101,6 +101,17 @@
         [:p [:span {:class (str "metric " (name css-class))} value]
             [:span {:class "label"} label]]]]]))

+(defn- format-delta
+  "Create a display fragment for a delta value."
+
+  ([delta prior-date]
+  (let [pos (when (pos? delta) "+")]
+    (str "(" pos (if (zero? delta) "no change" (utils/with-size-label delta)) "% since " prior-date ") ")))
+
+  ([currency delta prior-date]
+  (str "(" (if (zero? delta) "no change" (utils/with-currency currency (utils/with-size-label delta) true))
+    " since " prior-date ") ")))
+
 (defn- growth-metric [periods metadata currency]
   (let [growth-metric (first periods)
         slug (:slug growth-metric)
@@ -113,7 +124,7 @@
         date (when (and interval period) (utils/format-period interval period))
         value (:value growth-metric)
         ;; Check for older periods contiguous to most recent
-        contiguous-periods (when (not (empty? periods)) (utils/contiguous (map :period periods) (keyword interval)))
+        contiguous-periods (when (seq periods) (utils/contiguous (map :period periods) (keyword interval)))
         prior-contiguous? (>= (count contiguous-periods) 2)
         ;; Info on prior period
         prior-metric (when prior-contiguous?
@@ -145,17 +156,6 @@
       [:tr
         (into [:td]
           (map #(growth-metric % metadata currency) periods))]]))
-
-(defn- format-delta
-  "Create a display fragment for a delta value."
-
-  ([delta prior-date]
-  (let [pos (when (pos? delta) "+")]
-    (str "(" pos (if (zero? delta) "no change" (utils/with-size-label delta)) "% since " prior-date ") ")))
-
-  ([currency delta prior-date]
-  (str "(" (if (zero? delta) "no change" (utils/with-currency currency (utils/with-size-label delta) true))
-    " since " prior-date ") ")))

 (defn- finance-metrics [topic currency]
   (let [sorted-finances (reverse (sort-by :period (:data topic)))