fix formatting

fix formatting

--- src/blogiseq/site.clj
+++ src/blogiseq/site.clj
@@ -58,29 +58,29 @@
     (include-css-resources)
     (include-js-resources)
     (slurp "resources/misc_header.html") ; include this as-is. this deserves some polishing
-   [:body
-    [:div.w3-content.w3-light-yellow
-     [:nav#mySidenav.w3-sidenav.w3-light-yellow.w3-collapse {:style "z-index:3;width:250px;margin-top:51px;background-color:#fffbc7;"}
-      [:a {:title "Close menu"
-           :class "w3-right w3-xlarge w3-padding-large w3-hover-black w3-hide-large"
-           :onclick "w3_close()"
-           :href "javascript:void(0)"}
-       "close menu"
-       [:i {:class "fa fa-remove"}]
-       ]
-      [:div (generate-menu-navi "resources/meta.edn")]]
-     [:div {:id "myOverlay",
-            :title "close side menu",
-            :style "cursor:pointer",
-            :onclick "w3_close()",
-            :class "w3-overlay w3-hide-large"}]
-     [:div.w3-main {:style "margin-left:300px"} [:div
-                                                 [:header {:class "w3-container"}
-                                                  [:span {:onclick "w3_open()"
-                                                          :class "w3-opennav w3-hide-large w3-xxlarge w3-hover-text-grey"}
-                                                   [:i {:class  "fa fa-bars"}]]]
-                                                 content]]
-     ]]]])
+    [:body
+     [:div.w3-content.w3-light-yellow
+      [:nav#mySidenav.w3-sidenav.w3-light-yellow.w3-collapse {:style "z-index:3;width:250px;margin-top:51px;background-color:#fffbc7;"}
+       [:a {:title "Close menu"
+            :class "w3-right w3-xlarge w3-padding-large w3-hover-black w3-hide-large"
+            :onclick "w3_close()"
+            :href "javascript:void(0)"}
+        "close menu"
+        [:i {:class "fa fa-remove"}]
+        ]
+       [:div (generate-menu-navi "resources/meta.edn")]]
+      [:div {:id "myOverlay",
+             :title "close side menu",
+             :style "cursor:pointer",
+             :onclick "w3_close()",
+             :class "w3-overlay w3-hide-large"}]
+      [:div.w3-main {:style "margin-left:300px"} [:div
+                                                  [:header {:class "w3-container"}
+                                                   [:span {:onclick "w3_open()"
+                                                           :class "w3-opennav w3-hide-large w3-xxlarge w3-hover-text-grey"}
+                                                    [:i {:class  "fa fa-bars"}]]]
+                                                  content]]
+      ]]]])

 (defn render
   "Renders whole site. Takes chunks of hiccup and renders them in standalone


Fix parentheses to brackets in user ns declaration.

--- dev/user.clj
+++ dev/user.clj
@@ -2,11 +2,11 @@

 (ns user
   (:require
-   [clojure.pprint :refer (pprint)]
+   [clojure.pprint :refer [pprint]]
    [clojure.test :refer [run-all-tests]]
-   [clojure.reflect :refer (reflect)]
-   [clojure.repl :refer (apropos dir doc find-doc pst source)]
-   [clojure.tools.namespace.repl :refer (refresh refresh-all)]
+   [clojure.reflect :refer [reflect]]
+   [clojure.repl :refer [apropos dir doc find-doc pst source]]
+   [clojure.tools.namespace.repl :refer [refresh refresh-all]]
    [clojure.java.io :as io]
    [com.stuartsierra.component :as component]
    [clojure.core.async :as a :refer [>! <! >!! <!! chan buffer dropping-buffer sliding-buffer close! timeout alts! alts!! go-loop]]


preserves user-agent

preserves user-agent

--- src/complico/core.clj
+++ src/complico/core.clj
@@ -28,8 +28,8 @@
         (string/split url #"/"))) "/"))

 ; make a http request to url and download the body as string
-(defn request-url-page [url]
-  (:body (client/get url)))
+(defn request-url-page [url user-agent]
+  (:body (client/get url {:headers {"user-agent" user-agent}})))

 (defn create-grease [host]
   (str host "/convert?url="))
@@ -56,11 +56,11 @@
           grease (create-grease (create-host server port))]
             (response/redirect (str grease (codec/url-encode (str external-search-url search-term)))))))

-  (GET "/convert" {params :query-params server :server-name port :server-port}
+  (GET "/convert" {params :query-params server :server-name port :server-port headers :headers}
     (let [url (params "url")
           original-host (extract-host url)
           base-element (create-base-html original-host)
-          original-page-html (request-url-page url)
+          original-page-html (request-url-page url (headers "user-agent"))
           complico-host (create-host server port)
           script-html (create-script-html original-host complico-host)]
       (str base-element original-page-html script-html)))


fixed this bitch

fixed this bitch

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -8,10 +8,8 @@

 (defn write
   [content filename]
-  (pprint
-   content
-   (io/writer
-    filename :append true)))
+  (println (-> content :url class))
+  (spit filename (with-out-str (prn content)) :append true))

 (defn distinct-by-key
  [coll k]
@@ -84,102 +82,109 @@
       (do
         (println :total-score (/ sum-score num-decisions))
         (println :cur-page-score score)
-        (write
-         {:url       url
-          :body      body
-          :src-url   (-> queue first :source)
-          :src-xpath (-> queue first :src-xpath)}
-         "crawl.json")
         (if (or paginated?
                 (< (* 0.75
                       (/ sum-score num-decisions))
                    score))
-
-          (let [;; the decision made by the pagination component
-                paging-dec   (extractor/weak-pagination-detector
-                              body
-                              (first queue)
-                              globals
-                              (clojure.set/union visited
-                                                 (map #(-> % :url) content-q)
-                                                 (map #(-> % :url) paging-q)
-                                                 [url]))
-
-                ;; pagination's xpath and links
-                paging-xp-ls (into
-                              {} (map
-                                  (fn [[xpath info]]
-                                    [xpath (:links info)])
-                                  paging-dec))
-
-                paging-vocab (reduce
-                              clojure.set/union
-                              (map
-                               (fn [[xpath info]]
-                                 (:vocab info))
-                               paging-dec))
+          (do
+            (write
+             {:url       url
+              :body      body
+              :src-url   (-> queue first :source)
+              :src-xpath (-> queue first :src-xpath)}
+             "crawl.json")
+            (let [ ;; the decision made by the pagination component
+                  paging-dec   (extractor/weak-pagination-detector
+                                body
+                                (first queue)
+                                globals
+                                (clojure.set/union visited
+                                                   (map #(-> % :url) content-q)
+                                                   (map #(-> % :url) paging-q)
+                                                   [url]))
+
+                  ;; pagination's xpath and links
+                  paging-xp-ls (into
+                                {} (map
+                                    (fn [[xpath info]]
+                                     [xpath (:links info)])
+                                    paging-dec))
+
+                  paging-vocab (reduce
+                                clojure.set/union
+                                (map
+                                 (fn [[xpath info]]
+                                   (:vocab info))
+                                 paging-dec))
+
+                  new-globals  (merge-with clojure.set/union
+                                           globals
+                                           {:paging-vocab paging-vocab})
+
+                  ;; add to content-q if anything needs adding/removing
+                  content-q'   (concat (if (= :content queue-kw)
+                                         (rest content-q) content-q)
+                                       (distinct-by-key
+                                        (flatten
+                                         (map
+                                          (fn [[x links]]
+                                            (filter
+                                             identity
+                                             (map
+                                              (fn [a-link]
+                                                (when-not (and (some #{a-link} visited)
+                                                               (some #{a-link}
+                                                                     (set
+                                                                      (map #(-> % :url) content-q))))
+                                                  {:url a-link
+                                                   :source url
+                                                   :src-xpath x}))
+                                              links)))
+                                          decision))
+                                        :url))
+
+                  ;; add to paging-q if anything needs adding/removing
+                  paging-q'    (concat (if (= :pagination queue-kw)
+                                         (rest paging-q) paging-q)
+                                       (distinct-by-key
+                                        (flatten
+                                         (map (fn [[xpath links]]
+                                                (map
+                                                 (fn [a-link]
+                                                   (when-not (and (some #{a-link} visited)
+                                                                  (some #{a-link}
+                                                                        (set
+                                                                         (map #(-> % :url) content-q))))
+                                                     {:url a-link
+                                                      :source url
+                                                      :src-xpath xpath
+                                                      :pagination? true
+                                                      :content-xpaths xpaths}))
+                                                 links))
+                                              paging-xp-ls))
+                                        :url))
+

-                new-globals  (merge-with clojure.set/union
-                                         globals
-                                         {:paging-vocab paging-vocab})
-
-                ;; add to content-q if anything needs adding/removing
-                content-q'   (concat (if (= :content queue-kw)
-                                       (rest content-q) content-q)
-                                     (distinct-by-key
-                                      (flatten
-                                       (map
-                                        (fn [[x links]]
-                                          (filter
-                                           identity
-                                           (map
-                                            (fn [a-link]
-                                              (when-not (and (some #{a-link} visited)
-                                                             (some #{a-link}
-                                                                   (set
-                                                                    (map #(-> % :url) content-q))))
-                                                {:url a-link
-                                                 :source url
-                                                 :src-xpath x}))
-                                            links)))
-                                        decision))
-                                      :url))
-
-                ;; add to paging-q if anything needs adding/removing
-                paging-q'    (concat (if (= :pagination queue-kw)
-                                       (rest paging-q) paging-q)
-                                     (distinct-by-key
-                                      (flatten
-                                       (map (fn [[xpath links]]
-                                              (map
-                                               (fn [a-link]
-                                                 (when-not (and (some #{a-link} visited)
-                                                                (some #{a-link}
-                                                                      (set
-                                                                       (map #(-> % :url) content-q))))
-                                                   {:url a-link
-                                                    :source url
-                                                    :src-xpath xpath
-                                                    :pagination? true
-                                                    :content-xpaths xpaths}))
-                                               links))
-                                            paging-xp-ls))
-                                      :url))
-
-
-                new-num-dec  (inc num-decisions)
-                new-scr      (+ score sum-score)
-                new-lim      (dec limit)]
-            (recur {:content content-q'
-                    :pagination paging-q'}
-                   new-visited
-                   new-num-dec
-                   new-scr
-                   new-lim
-                   new-globals))
+                  new-num-dec  (inc num-decisions)
+                  new-scr      (+ score sum-score)
+                  new-lim      (dec limit)]
+              (recur {:content content-q'
+                      :pagination paging-q'}
+                     new-visited
+                     new-num-dec
+                     new-scr
+                     new-lim
+                     new-globals)))
           (do
             (println :no-links-chosen)
             (println)
+            (write
+             {:url       url
+              :body      body
+              :src-url   (-> queue first :source)
+              :src-xpath (-> queue first :src-xpath)
+              :leaf?     true}
+             "crawl.json")
             (let [paging-dec   (extractor/weak-pagination-detector
                                 body
                                 (first queue)


speedup

speedup

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -547,7 +547,13 @@
                                                                   (leaf? {:anchor-text (:src-text x)
                                                                           :src-url     (:url x)
                                                                           :body        (:body x)}))
-                                                                 (catch Exception e nil))}))
+                                                                 (catch Exception e nil))
+
+                                                         :xpath-texts (if (:body x)
+                                                                        (similarity/char-frequency-representation
+                                                                         (similarity/page-text-xpaths
+                                                                          (:body x)))
+                                                                        {})}))
                                              sampled-corpus)
                                   :new-visited links-list
                                   :crawled (map :url links-and-texts)})))
@@ -725,7 +731,7 @@
              url-ds (if (= pick-from :first)
                       (-> url-queue first)
                       (-> url-queue last))]
-
+
          (utils/sayln :url url)
          (utils/sayln :src-url src-url)
          (utils/sayln :src-path (:path url-ds))
@@ -838,8 +844,14 @@
   ([entry-point leaf? extract stop? build-model]
      (let [body           (do (utils/download-with-cookie entry-point)
                               (utils/download-with-cookie entry-point))
+           xpath-texts    (if (:body body)
+                            (similarity/char-frequency-representation
+                             (similarity/page-text-xpaths
+                              (:body body)))
+                            {})
            body-queue-ele {:url  entry-point
-                           :body (:body body)}]
+                           :body (:body body)
+                           :xpath-texts xpath-texts}]
        (crawl-with-estimation-example [body-queue-ele]
                                       [entry-point]
                                       leaf?
@@ -849,7 +861,8 @@
                                       {entry-point {:body (:body body)
                                                     :url entry-point
                                                     :src-url nil
-                                                    :src-text nil}}
+                                                    :src-text nil
+                                                    :xpath-texts xpath-texts}}
                                       (if (leaf? {:anchor-text nil
                                                   :src-url     nil
                                                   :body        (:body body)})
@@ -934,18 +947,25 @@
                                             []
                                             (reduce
                                              (fn [clusters-so-far x]
-                                               (let [to-assign (.indexOf
+                                               (let [x-xpaths  (:xpath-texts x)
+                                                     to-assign (.indexOf
                                                                 (map
                                                                  (fn [a-cluster]
-                                                                   (let [num-matched (count
-                                                                                (filter
-                                                                                (fn [c]
-                                                                                (similarity/similar?
-                                                                                (-> c new-corpus :body)
-                                                                                (:body x)))
-                                                                                a-cluster))]
-                                                                     (>= num-matched (/ (count a-cluster)
-                                                                                2))))
+                                                                   ;; (let [num-matched (count
+                                                                   ;;                    (filter
+                                                                   ;;                     (fn [c]
+                                                                   ;;                       (similarity/similar?
+                                                                   ;;                        (-> c new-corpus :body)
+                                                                   ;;                        (:body x)))
+                                                                   ;;                     a-cluster))]
+                                                                   ;;   (>= num-matched (/ (count a-cluster)
+                                                                   ;;                      2)))
+                                                                   (some
+                                                                    (fn [c]
+                                                                      (similarity/similar-xpaths?
+                                                                       (-> c new-corpus :xpath-texts)
+                                                                       x-xpaths))
+                                                                    a-cluster))
                                                                  clusters-so-far)
                                                                 true)]
                                                  (if (neg? to-assign)


Add proper flags handling for copy/move operations.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -61,23 +61,34 @@
   ([fst & more]
    (pt/-path (cons fst more))))

-;; (def write-open-opts
-;;   (->> [StandardOpenOption/TRUNCATE_EXISTING
-;;         StandardOpenOption/CREATE
-;;         StandardOpenOption/WRITE]
-;;        (into-array OpenOption)))
-
-;; (def read-open-opts
-;;   (->> [StandardOpenOption/READ]
-;;        (into-array OpenOption)))
-
-;; (def moveo-opts
-;;   (->> [StandardCopyOption/ATOMIC_MOVE
-;;         StandardCopyOption/REPLACE_EXISTING]
-;;        (into-array CopyOption)))
-
-;; (def follow-link-opts
-;;   (into-array LinkOption [LinkOption/NOFOLLOW_LINKS]))
+(def ^:private open-opts-map
+  {:truncate StandardOpenOption/TRUNCATE_EXISTING
+   :create StandardOpenOption/CREATE
+   :append StandardOpenOption/APPEND
+   :create-new StandardOpenOption/CREATE_NEW
+   :delete-on-close StandardOpenOption/DELETE_ON_CLOSE
+   :dsync StandardOpenOption/DSYNC
+   :read StandardOpenOption/READ
+   :write StandardOpenOption/WRITE
+   :sparse StandardOpenOption/SPARSE
+   :sync StandardOpenOption/SYNC})
+
+(def ^:private copy-opts-map
+  {:atomic StandardCopyOption/ATOMIC_MOVE
+   :replace StandardCopyOption/REPLACE_EXISTING
+   :copy-attributes StandardCopyOption/COPY_ATTRIBUTES})
+
+(defn- interpret-open-opts
+  [opts]
+  {:pre [(every? open-opts-map opts)]}
+  (->> (map open-opts-map opts)
+       (into-array OpenOption)))
+
+(defn- interpret-copy-opts
+  [opts]
+  {:pre [(every? copy-opts-map opts)]}
+  (->> (map copy-opts-map opts)
+       (into-array CopyOption)))

 (defn make-permissions
   "Generate a array of `FileAttribute` instances
@@ -107,13 +118,13 @@
   "Check if the provided path exists."
   [path]
   (let [^Path path (pt/-path path)]
-    (Files/exists path follow-link-opts)))
+    (Files/exists path *no-follow*)))

 (defn directory?
   "Checks if the provided path is a directory."
   [path]
   (let [^Path path (pt/-path path)]
-    (Files/isDirectory path follow-link-opts)))
+    (Files/isDirectory path *no-follow*)))

 (defn regular-file?
   "Checks if the provided path is a plain file."
@@ -280,10 +291,12 @@
   require moving the entries in the directory. When moving a directory
   requires that its entries be moved then this method fails (by
   throwing an IOException)."
-  [src dst]
-  (let [^Path src (-path src)
-        ^Path dst (-path dst)]
-    (Files/move src dst move-opts)))
+  ([src dst] (move src dst #{:atomic :replace}))
+  ([src dst flags]
+   (let [^Path src (pt/-path src)
+         ^Path dst (pt/-path dst)
+         opts (interpret-copy-opts flags)]
+    (Files/move src dst opts))))

 (defn create-tempfile
   "Create a temporal file."


Added functions to parse int/float/boolean into config_loader.clj

--- src/emender_jenkins/config_loader.clj
+++ src/emender_jenkins/config_loader.clj
@@ -1,6 +1,34 @@
+;
+;  (C) Copyright 2016  Pavel Tisnovsky
+;
+;  All rights reserved. This program and the accompanying materials
+;  are made available under the terms of the Eclipse Public License v1.0
+;  which accompanies this distribution, and is available at
+;  http://www.eclipse.org/legal/epl-v10.html
+;
+;  Contributors:
+;      Pavel Tisnovsky
+;
+
 (ns emender-jenkins.config-loader)

 (require '[clojure-ini.core :as clojure-ini])
+
+(defn parse-int
+    "Parse the given string as an integer number."
+    [string]
+    (java.lang.Integer/parseInt string))
+
+(defn parse-float
+    "Parse the given string as a float number."
+    [string]
+    (java.lang.Float/parseFloat string))
+
+(defn parse-boolean
+    "Parse the given string as a boolean value."
+    [string]
+    (or (= string "true")
+        (= string "True")))

 (defn properties->map
     "Convert property entries into map."


Respect the dynamic var instance.

Respect the dynamic var instance.

--- src/decimal/core.cljs
+++ src/decimal/core.cljs
@@ -99,7 +99,7 @@
                   :toExpNeg (:to-exp-neg options (.-toExpNeg +decimal+))
                   :toExpPos (:to-exp-pos options (.-toExpPos +decimal+))
                   :crypto (:crypto options (.-crypto +decimal+))}]
-    (.set +decimal+ opts)
+    (.set *decimal* opts)
     nil))

 (defn config
@@ -136,7 +136,7 @@
 (defn ^boolean decimal?
   "Return true if `v` is a instance of Decimal."
   [v]
-  (instance? +decimal+ v))
+  (instance? *decimal* v))

 (defn ^boolean finite?
   "Returns true if the value of this Decimal is a finite
@@ -282,12 +282,12 @@
 (defn max
   "Returns a new Decimal whose value is the maximum."
   [& args]
-  (.apply (.-max +decimal+) +decimal+ (clj->js args)))
+  (.apply (.-max *decimal*) *decimal* (clj->js args)))

 (defn min
   "Returns a new Decimal whose value is the minimum."
   [& args]
-  (.apply (.-min +decimal+) +decimal+ (clj->js args)))
+  (.apply (.-min *decimal*) *decimal* (clj->js args)))

 ;; Aliases

@@ -464,7 +464,7 @@
   "Returns a new Decimal whose value is the square root of the sum
   of the squares of the arguments."
   [& params]
-  (.apply (.-hypot +decimal+) +decimal+ (clj->js params)))
+  (.apply (.-hypot *decimal*) *decimal* (clj->js params)))

 (defn neg
   "Returns a new Decimal whose value is the value of this Decimal negated."
@@ -735,7 +735,7 @@
 ;; Protocols
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(extend-type +decimal+
+(extend-type *decimal*
   cljs.core/IEquiv
   (-equiv [v other]
     (.eq v other))
@@ -759,7 +759,7 @@
     (.comparedTo v other)))

 (extend-protocol IDecimal
-  +decimal+
+  *decimal*
   (-decimal [v] v)

   string


#99 fix indentation

#99 fix indentation

--- src/cheshire/core.clj
+++ src/cheshire/core.clj
@@ -15,87 +15,86 @@
 										ByteArrayOutputStream OutputStream Reader Writer)))

 (def ^:private default-pretty-print-options
-	{:indentation 2
-	 :indent-arrays? false
-	 :indent-objects? true
-	 :before-array-values nil
-	 :after-array-values nil
-	 :object-field-value-separator nil})
+  {:indentation 2
+   :indent-arrays? false
+   :indent-objects? true
+   :before-array-values nil
+   :after-array-values nil
+   :object-field-value-separator nil})

 (defn- create-pretty-printer
-	 "Returns an instance of CustomPrettyPrinter based on the configuration
-	 provided as argument"
-	 [options]
-	 (let [{:keys [indentation
-								 indent-arrays?
-								 indent-objects?
-								 before-array-values
-								 after-array-values
-								 object-field-value-separator]} (merge default-pretty-print-options options)]
-		(-> (new CustomPrettyPrinter)
-				(.setIndentation indentation indent-objects? indent-arrays?)
-				(.setBeforeArrayValues before-array-values)
-				(.setAfterArrayValues after-array-values)
-				(.setObjectFieldValueSeparator object-field-value-separator))))
+  "Returns an instance of CustomPrettyPrinter based on the configuration
+  provided as argument"
+  [options]
+  (let [{:keys [indentation
+                indent-arrays?
+                indent-objects?
+                before-array-values
+                after-array-values
+                object-field-value-separator]} (merge default-pretty-print-options options)]
+    (-> (new CustomPrettyPrinter)
+            (.setIndentation indentation indent-objects? indent-arrays?)
+            (.setBeforeArrayValues before-array-values)
+            (.setAfterArrayValues after-array-values)
+            (.setObjectFieldValueSeparator object-field-value-separator))))

 ;; Generators
 (defn ^String generate-string
-	"Returns a JSON-encoding String for the given Clojure object. Takes an
-	optional date format string that Date objects will be encoded with.
-
-	The default date format (in UTC) is: yyyy-MM-dd'T'HH:mm:ss'Z'"
-	([obj]
-	 (generate-string obj nil))
-	([obj opt-map]
-	 (let [sw (StringWriter.)
-				 print-pretty (:pretty opt-map)
-				 generator (.createGenerator
-										^JsonFactory (or factory/*json-factory*
-																		 factory/json-factory)
-										^Writer sw)]
-		 (when print-pretty
-				(if (= print-pretty true)
-					; pretty = true uses default pretty printer
-					(.useDefaultPrettyPrinter generator)
-					; else we construct a custom pretty printer
-					(.setPrettyPrinter generator (create-pretty-printer print-pretty))))
-		 (when (:escape-non-ascii opt-map)
-			 (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
-		 (gen/generate generator obj
-									 (or (:date-format opt-map) factory/default-date-format)
-									 (:ex opt-map)
-									 (:key-fn opt-map))
-		 (.flush generator)
-		 (.toString sw))))
+  "Returns a JSON-encoding String for the given Clojure object. Takes an
+  optional date format string that Date objects will be encoded with.
+
+  The default date format (in UTC) is: yyyy-MM-dd'T'HH:mm:ss'Z'"
+  ([obj]
+   (generate-string obj nil))
+  ([obj opt-map]
+   (let [sw (StringWriter.)
+         print-pretty (:pretty opt-map)
+         generator (.createGenerator
+                    ^JsonFactory (or factory/*json-factory*
+                                     factory/json-factory)
+                    ^Writer sw)]
+    (when print-pretty
+      (if (= print-pretty true)
+        ; pretty = true uses default pretty printer
+        (.useDefaultPrettyPrinter generator)
+        ; else we construct a custom pretty printer
+        (.setPrettyPrinter generator (create-pretty-printer print-pretty))))
+    (when (:escape-non-ascii opt-map)
+      (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
+    (gen/generate generator obj
+                  (or (:date-format opt-map) factory/default-date-format)
+                  (:ex opt-map)
+                  (:key-fn opt-map))
+    (.flush generator)
+    (.toString sw))))

 (defn ^BufferedWriter generate-stream
-	"Returns a BufferedWriter for the given Clojure object with the JSON-encoded
-	data written to the writer. Takes an optional date format string that Date
-	objects will be encoded with.
-
-	The default date format (in UTC) is: yyyy-MM-dd'T'HH:mm:ss'Z'"
-	([obj ^BufferedWriter writer]
-	 (generate-stream obj writer nil))
-	([obj ^BufferedWriter writer opt-map]
-	 (let [generator (.createGenerator
-										^JsonFactory (or factory/*json-factory*
-																		 factory/json-factory)
-										^Writer writer)
-				 print-pretty (:pretty opt-map)]
-		 (when print-pretty
-			 (if (= print-pretty true)
-				 ; pretty = true uses default pretty printer
-				 (.useDefaultPrettyPrinter generator)
-				 ; else we construct a custom pretty printer
-				 (.setPrettyPrinter generator (create-pretty-printer print-pretty))))
-		 (when (:escape-non-ascii opt-map)
-			 (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
-		 (gen/generate generator obj (or (:date-format opt-map)
-																		 factory/default-date-format)
-									 (:ex opt-map)
-									 (:key-fn opt-map))
-		 (.flush generator)
-		 writer)))
+  "Returns a BufferedWriter for the given Clojure object with the JSON-encoded
+  data written to the writer. Takes an optional date format string that Date
+  objects will be encoded with.
+
+  The default date format (in UTC) is: yyyy-MM-dd'T'HH:mm:ss'Z'"
+  ([obj ^BufferedWriter writer]
+   (generate-stream obj writer nil))
+  ([obj ^BufferedWriter writer opt-map]
+   (let [generator (.createGenerator
+                    ^JsonFactory (or factory/*json-factory*
+                                                     factory/json-factory)
+                    ^Writer writer)
+         print-pretty (:pretty opt-map)]
+     (when print-pretty
+       (if (= print-pretty true)
+           ; pretty = true uses default pretty printer
+           (.useDefaultPrettyPrinter generator)
+           ; else we construct a custom pretty printer
+           (.setPrettyPrinter generator (create-pretty-printer print-pretty))))
+     (when (:escape-non-ascii opt-map)
+       (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
+     (gen/generate generator obj (or (:date-format opt-map) factory/default-date-format)
+                                     (:ex opt-map)
+                                     (:key-fn opt-map))
+     (.flush generator)
+     writer)))

 (defn create-generator [writer]
 	"Returns JsonGenerator for given writer."


* src/clj/cljs/core.clj: eliminate truth tests from satifies?

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -488,13 +488,14 @@
   "Returns true if x satisfies the protocol"
   [psym x]
   (let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
-        prefix (protocol-prefix p)]
-    `(let [x# ~x]
-       (if (and x#
-                (. x# ~(symbol (core/str "-" prefix)))        ;; Need prop lookup here
-                (not (. x# (~'hasOwnProperty ~prefix))))
+        prefix (protocol-prefix p)
+        xsym (gensym)]
+    `(let [~xsym ~x]
+       (if (and (coercive-not= ~xsym nil)
+                ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix)))) ;; Need prop lookup here
+                (coercive-not (. ~xsym (~'hasOwnProperty ~prefix))))
 	 true
-	 (cljs.core/type_satisfies_ ~psym x#)))))
+	 (cljs.core/type_satisfies_ ~psym ~xsym)))))

 (defmacro lazy-seq [& body]
   `(new cljs.core.LazySeq nil false (fn [] ~@body)))


Use lein release 1.0.5 rather than our internal version

--- src/leiningen/new/cljskel/project.clj
+++ src/leiningen/new/cljskel/project.clj
@@ -31,7 +31,7 @@

   :plugins [[lein-ring "0.8.12"]
             [lein-environ "1.0.0"]
-            [lein-release "1.0.73"]]
+            [lein-release "1.0.5"]]

   :env {:environment-name "poke"
         :service-name "{{name}}"
@@ -46,7 +46,8 @@
         :production "false"
         :shutdown-timeout-millis "5000"}

-  :lein-release {:release-tasks [:clean :uberjar :pom :rpm]}
+  :lein-release {:deploy-via :shell
+                 :shell ["lein" "do" "clean," "uberjar," "pom," "rpm"]}

   :ring {:handler {{name}}.web/app
          :main {{name}}.setup


remove outstanding re-find calls

remove outstanding re-find calls

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -544,7 +544,7 @@
   ([state side card key n] (add-prop state side card key n nil))
   ([state side card key n {:keys [placed] :as args}]
    (let [updated-card (if
-                        (and (contains? card :subtype) (re-find #"Virus" (:subtype card)))
+                        (has? card :subtype "Virus")
                         (assoc card :added-virus-counter true)
                         card
                         )]
@@ -1599,7 +1599,7 @@
                  (if (and
                        (contains? installed-card :counter)
                        (contains? installed-card :subtype)
-                       (re-find #"Virus" (:subtype card))
+                       (has? card :subtype "Virus")
                        (> (:counter installed-card) 0))
                    (update! state side (assoc installed-card :added-virus-counter true))
                    )


bumped up figwheel

bumped up figwheel

--- src/leiningen/new/reagent/project.clj
+++ src/leiningen/new/reagent/project.clj
@@ -56,7 +56,7 @@
                    :dependencies [[ring-mock "0.1.5"]
                                   [ring/ring-devel "1.3.2"]
                                   [leiningen-core "2.5.1"]
-                                  [lein-figwheel "0.3.3"]
+                                  [lein-figwheel "0.3.5"]
                                   [org.clojure/tools.nrepl "0.2.10"]
                                   [pjstadig/humane-test-output "0.7.0"]{{{dev-dependencies}}}]


Show auto pump cost in the log message

Show auto pump cost in the log message

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1201,8 +1201,9 @@
         pumpnum (when strdif (int (Math/ceil (/ strdif (:pump pumpabi)))))]
     (when (and pumpnum pumpcst (>= (get-in @state [:runner :credit]) (* pumpnum pumpcst)))
       (dotimes [n pumpnum] (resolve-ability state side (dissoc pumpabi :msg) (get-card state card) nil))
-      (system-msg state side (str "increases the strength of " (:title card) " to "
-                                  (:current-strength (get-card state card)))))))
+      (system-msg state side (str "spends " (* pumpnum pumpcst) " [Credits] to increase the strength of "
+                                  (:title card) " to " (:current-strength (get-card state card)))))))
+
 (defn turn-events [state side ev]
   (mapcat #(rest %) (filter #(= ev (first %)) (:turn-events @state))))


Associate :prompt-type with prompts to distinguish selects from normal prompts.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -204,13 +204,13 @@

 (defn show-prompt
   ([state side card msg choices f] (show-prompt state side card msg choices f nil))
-  ([state side card msg choices f priority]
+  ([state side card msg choices f {:keys [priority prompt-type] :as args}]
    (let [prompt (if (string? msg) msg (msg state side card nil))]
      (when (or (:number choices) (#{:credit :counter} choices) (> (count choices) 0))
        (swap! state update-in [side :prompt]
               (if priority
-                #(cons {:msg prompt :choices choices :effect f :card card} (vec %))
-                #(conj (vec %) {:msg prompt :choices choices :effect f :card card})))))))
+                #(cons {:msg prompt :choices choices :effect f :card card :prompt-type prompt-type} (vec %))
+                #(conj (vec %) {:msg prompt :choices choices :effect f :card card :prompt-type prompt-type})))))))

 (defn resolve-psi [state side card psi bet]
   (swap! state assoc-in [:psi side] bet)
@@ -233,8 +233,8 @@

 (defn prompt!
   ([state side card msg choices ability] (prompt! state side card msg choices ability nil))
-  ([state side card msg choices ability priority]
-    (show-prompt state side card msg choices #(resolve-ability state side ability card [%]) priority)))
+  ([state side card msg choices ability {:keys [priority prompt-type] :as args}]
+    (show-prompt state side card msg choices #(resolve-ability state side ability card [%]) args)))

 (defn optional-ability [state side card msg ability targets]
   (show-prompt state side card msg ["Yes" "No"] #(if (= % "Yes")
@@ -276,7 +276,7 @@

 (defn show-select
   ([state side card ability] (show-select state side card ability nil))
-  ([state side card ability priority]
+  ([state side card ability {:keys [priority] :as args}]
    (let [ability (update-in ability [:choices :max] #(if (fn? %) (% state side card nil) %))]
      (swap! state update-in [side :selected]
             #(conj (vec %) {:ability (dissoc ability :choices) :req (get-in ability [:choices :req])
@@ -287,7 +287,8 @@
                     (if-let [m (get-in ability [:choices :max])]
                       (str "Select up to " m " targets for " (:title card))
                       (str "Select a target for " (:title card))))
-                  ["Done"] (fn [choice] (resolve-select state side)) priority))))
+                  ["Done"] (fn [choice] (resolve-select state side))
+                  (assoc args :prompt-type :select)))))

 (defn resolve-ability [state side {:keys [counter-cost advance-counter-cost cost effect msg req once
                                           once-key optional prompt choices end-turn player psi trace
@@ -308,7 +309,7 @@
       (if choices
         (if (map? choices)
           (if (:req choices)
-            (show-select state (or player side) card ability priority)
+            (show-select state (or player side) card ability {:priority priority})
             (let [n ((:number choices) state side card targets)]
               (prompt! state (or player side) card prompt {:number n} (dissoc ability :choices))))
           (let [cs (if-not (fn? choices)
@@ -316,7 +317,7 @@
                      (let [cards (choices state side card targets)]
                              (if not-distinct
                                cards (distinct-by :title cards))))]
-            (prompt! state (or player side) card prompt cs (dissoc ability :choices) priority)))
+            (prompt! state (or player side) card prompt cs (dissoc ability :choices) {:priority priority})))
         (when (and (or (not counter-cost) (<= counter-cost (or counter 0)))
                    (or (not advance-counter-cost) (<= advance-counter-cost (or advance-counter 0)))
                    (apply pay (concat [state side card] cost)))


Add function all-installed. Better icebreaker strength reset code.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -21,7 +21,7 @@
     (say state side {:user "__system__" :text (str username " " text ".")})))

 (declare prompt! forfeit trigger-event handle-end-run trash update-advancement-cost update-all-advancement-costs
-         update-ice-strength update-breaker-strength)
+         update-ice-strength update-breaker-strength all-installed)

 (defn pay [state side card & args]
   (let [costs (merge-costs (remove #(or (nil? %) (= % [:forfeit])) args))
@@ -321,10 +321,10 @@
             (trigger-event state side :successful-run-ends (first server)))
           (when (get-in @state [:run :unsuccessful])
             (trigger-event state side :unsuccessful-run-ends (first server)))
-          (doseq [p (get-in @state [:runner :rig :program])]
-            (when (:current-strength p)
-              (do (update! state side (update-in (get-card state p) [:pump] dissoc :all-run))
-                  (update-breaker-strength state side p))))
+          (doseq [p (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))]
+            (update! state side (update-in (get-card state p) [:pump] dissoc :all-run))
+            (update! state side (update-in (get-card state p) [:pump] dissoc :encounter ))
+            (update-breaker-strength state side p))
           (let [run-effect (get-in @state [:run :run-effect])]
             (when-let [end-run-effect (:end-run run-effect)]
               (resolve-ability state side end-run-effect (:card run-effect) [(first server)]))))
@@ -631,13 +631,17 @@
 (defn trash-cards [state side cards]
   (doseq [c cards] (trash state side c)))

+(defn all-installed [state side]
+  (if (= side :runner)
+    (let [installed (flatten (for [t [:program :hardware :resource]] (get-in @state [:runner :rig t])))]
+      (concat installed (filter #(:installed %) (mapcat :hosted installed))))
+    (let [servers (->> (:corp @state) :servers seq flatten)]
+      (concat (mapcat :content servers) (mapcat :ices servers)))))
+
 (defn breaker-strength-bonus [state side n]
   (swap! state update-in [:bonus :breaker-strength] (fnil #(+ % n) 0)))

 (defn breaker-strength [state side {:keys [strength] :as card}]
-  ;(.println System/out (str (:title card) " strength " strength "; encounter " (get-in card [:pump :encounter])
-  ;                          "all-run " (get-in card [:pump :all-run])
-  ;                          "bonus " (get-in @state [:bonus :breaker-strength])))
   (if (nil? strength)
     nil
     (-> (if-let [strfun (:strength-bonus (card-def card))]
@@ -648,13 +652,10 @@
            (or (get-in @state [:bonus :breaker-strength]) 0)))))

 (defn update-breaker-strength [state side breaker]
-  ;(.println System/out (pr-str breaker))
   (let [breaker (get-card state breaker) oldstren (or (:current-strength breaker) (:strength breaker))]
-    ;(.println System/out (pr-str "AFTER " breaker))
     (swap! state update-in [:bonus] dissoc :breaker-strength)
     (trigger-event state side :pre-breaker-strength breaker)
     (update! state side (assoc breaker :current-strength (breaker-strength state side breaker)))
-    ;(.println System/out (pr-str "AFTER222 " (get-card state breaker)))
     (trigger-event state side :breaker-strength-changed (get-card state breaker) oldstren)))

 (defn pump
@@ -845,10 +846,9 @@
         (update-ice-in-server state side (card->server state ice))))
     (swap! state update-in [:run :position] dec)
     (swap! state assoc-in [:run :no-action] false)
-    (doseq [p (get-in @state [:runner :rig :program])]
-      (when (:current-strength p)
-        (do (update! state side (update-in (get-card state p) [:pump] dissoc :encounter))
-            (update-breaker-strength state side p))))
+    (doseq [p (filter #(has? % :subtype "Icebreaker") (all-installed state :runner))]
+      (update! state side (update-in (get-card state p) [:pump] dissoc :encounter))
+      (update-breaker-strength state side p))
     (system-msg state side "continues the run")
     (let [pos (get-in @state [:run :position])]
       (when (> (count (get-in @state [:run :ices])) 0)


Checkpoint

Checkpoint

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

--- src/cljparse/core.clj
+++ src/cljparse/core.clj
@@ -10,8 +10,7 @@
 (def cli-options
   ;; An option with a required argument
   [["-p" "--path PATH" "path to project to build"
-    :default "./"
-    :validate [#(and (.isDirectory (io/file %)) (.isFile (io/file % configname)))]]
+    :default "./"]
    ["-h" "--help"]])

 (defn exit [status msg]
@@ -27,9 +26,16 @@
     (cond (not= errors nil)
           (exit -1 (str "Error: " errors)))

-    (println "Starting cljparse with path:" (:path options) "and errors:" errors)
-    (config/parser (io/file (:path options) configname))))
+    (let [file (io/file (:path options) configname)]
+      (cond (not (.isFile file))
+            (exit -1 (str "Configuration not found at " (:path options))))
+
+      (println "Starting cljparse with path:" (:path options) "and errors:" errors)
+      (config/parser (io/file (:path options) configname)))))

+
+
+


add docker environment that always routes to backend

[ci skip]

--- src/frontend/core.clj
+++ src/frontend/core.clj
@@ -95,6 +95,8 @@
       (or
         (= env "enterprise")
         (= server-name "enterprise.circlehost")) {:proto "https" :host "enterprise-staging.sphereci.com"}
+      (= env "docker")
+      {:proto "http" :host (System/getenv "CIRCLE_BACKEND_HOST")}
       (re-matches #"(.*).circlehost" server-name) (when-let [env (some->> req :server-name (re-matches #"(.*).circlehost") second)]
                                                     {:proto "https" :host (format "%s.circleci.com" env)})
       :else {:proto "http" :host "dev.circlehost:8080"})))


allow non-simple, small bursts to contain triggering

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -33,6 +33,33 @@

 (defn if-assoc [pred m k v]
   (if pred (assoc m k v) m))
+
+(defn make-property-sequences [channel-properties]
+  (let [ms (for [item channel-properties]
+             (into {} (map #(let [[d p v] %]
+                              [[d p] v])
+                           item)))
+        ks (apply sorted-set
+                  (apply concat (map keys ms)))]
+    (into (sorted-map)
+      (for [[d p] ks]
+        [[d p] (map #(get % [d p]) ms)]))))
+
+(defn channels-sequenceable [property-sequences channels]
+  (and
+    (not (some false?
+           (for [[[d p] s] property-sequences]
+             (or (core isPropertySequenceable d p)
+                 (apply = s))))))
+    (apply == (map :exposure channels))
+    (apply = (map :z-offset channels)))
+
+
+(defn select-triggerable-sequences [property-sequences]
+  (into (sorted-map)
+    (filter #(let [[[d p] _] %]
+               (core isPropertySequenceable d p))
+            property-sequences)))

 (defn make-dimensions [settings]
   (let [{:keys [slices channels frames positions
@@ -113,23 +140,37 @@
       (if-assoc (not= (:frame-index e1) (:frame-index e2))
         e2 :wait-time-ms interval-ms))))

+(defn event-triggerable [e1 e2]
+  (channels-sequenceable
+    (make-property-sequences
+      [(:properties e1) (:properties e2)])
+      [(:channel e1) (:channel e2)]))
+
 (defn burst-valid [e1 e2]
   (and
     (let [wait-time (:wait-time-ms e2)]
       (or (nil? wait-time) (>= (:exposure e2) wait-time)))
-    (select-values-match? e1 e2 [:exposure :position :slice :channel])
+    (select-values-match? e1 e2 [:exposure :position :slice])
+    (event-triggerable e1 e2)
     (not (:autofocus e2))))

+(defn make-triggers [events]
+  (let [props (map #(-> % :channel :properties) events)]
+    (-> props make-property-sequences select-triggerable-sequences)))
+
 (defn make-bursts [events]
   (let [e1 (first events)
         ne (next events)
         [run later] (split-with #(burst-valid e1 %) ne)]
     (when e1
       (if (not (empty? run))
-        (lazy-cat (list (assoc e1 :task :init-burst
-                                  :burst-length (inc (count run))))
-                (map #(assoc % :task :collect-burst) run)
-                (make-bursts later))
+        (lazy-cat
+          (list (assoc e1 :task :init-burst
+                          :burst-length (inc (count run))
+                          :trigger-sequence (make-triggers (cons e1 run))))
+          (map #(assoc % :task :collect-burst) (drop-last run))
+          (list (assoc (last run) :task :finish-burst))
+          (make-bursts later))
         (lazy-cat (list e1) (make-bursts later))))))

 (defn add-next-task-tags [events]
@@ -222,31 +263,6 @@
                        :position (nth positions pos-index))
              simple)))))

-(defn make-property-sequences [channel-properties]
-  (let [ms (for [item channel-properties]
-             (into {} (map #(let [[d p v] %]
-                              [[d p] v])
-                           item)))
-        ks (apply sorted-set
-                  (apply concat (map keys ms)))]
-    (into (sorted-map)
-      (for [[d p] ks]
-        [[d p] (map #(get % [d p]) ms)]))))
-
-(defn channels-sequenceable [property-sequences channels]
-  (and
-    (not (some false?
-           (for [[[d p] s] property-sequences]
-             (or (core isPropertySequenceable d p)
-                 (apply = s))))))
-    (apply == (map :exposure channels)))
-
-(defn select-triggerable-sequences [property-sequences]
-  (into (sorted-map)
-    (filter #(let [[[d p] _] %]
-               (core isPropertySequenceable d p))
-            property-sequences)))
-
 (defn generate-acq-sequence [settings runnables]
   (let [{:keys [numFrames time-first positions slices channels
                 use-autofocus default-exposure interval-ms
@@ -258,7 +274,10 @@
                (> 2 num-positions))
            (> 2 (count slices))
            (or (> 2 (count channels))
-               (channels-sequenceable property-sequences channels))
+               (and
+                 (channels-sequenceable property-sequences channels)
+                 (apply == 0 (map :skip-frames channels))
+                 (apply = true (map :use-z-stack channels))))
            (or (not use-autofocus)
                (>= autofocus-skip (dec numFrames)))
            (zero? (count runnables))


aviary-filesystem: Fix merge-directories-test.

--- aviary-filesystem/src/test/aviary/filesystem_test.clj
+++ aviary-filesystem/src/test/aviary/filesystem_test.clj
@@ -45,6 +45,7 @@
           temp-b (new-temp-path)
           files #{"test-a/hello.txt"
                   "test-b/hello/gunter.txt"}]
+      (clean temp-b)
       (create-all temp-a files)
       (assert (dir-empty? temp-b))
       (assert (dir-contains? temp-a files))


rendering optimizations for sablono

rendering optimizations for sablono


Add drawing attribute on workspace.

Add drawing attribute on workspace.

--- frontend/uxbox/data/workspace.cljs
+++ frontend/uxbox/data/workspace.cljs
@@ -45,6 +45,7 @@
     (-apply-update [_ state]
       (let [s {:project projectid
                :toolboxes #{}
+               :drawing nil
                :selected #{}
                :page pageid}]
         (assoc state :workspace s)))


Workbench job seems to be more appropriate than UIJob.

--- ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreationOperation.clj
+++ ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreationOperation.clj
@@ -15,6 +15,7 @@
      [java.util.zip ZipFile]
      [org.eclipse.core.runtime NullProgressMonitor
                             SubProgressMonitor
+                            IProgressMonitor
                             CoreException
                             IStatus
                             Platform
@@ -35,7 +36,7 @@
      [org.eclipse.ui.wizards.datatransfer ImportOperation
                                           ZipFileStructureProvider]
      [org.eclipse.ui.browser IWorkbenchBrowserSupport]
-     [org.eclipse.ui.progress UIJob])
+     [org.eclipse.ui.progress WorkbenchJob])

   (:use
     [leiningen.core :only [read-project defproject]]
@@ -109,12 +110,13 @@
   "Calls resource-fn until it returns a non-nil value and returns it. If resource-fn
 returns nil, waits for step milliseconds, and repeats. Returns nil if resource-fn
 never returned a non-nil value before the timeout occurred."
-  [resource-fn timeout step]
+  [resource-fn timeout step monitor]
   (loop
     [self-timeout timeout]
     (if (and
           (> self-timeout 0)
-          (not (Thread/interrupted)))
+          (not (Thread/interrupted))
+          (not (.isCanceled monitor)))
       (let [resource (resource-fn)]
         (if resource
           resource
@@ -134,20 +136,25 @@
       nil)))

 (defn- open-browser
-"Open a browser for the running labrepl web page"
-[]
-	(if (wait-for-resource check-server *timeout* *step*)
-   (let
-	  [browser-support (.getBrowserSupport (PlatformUI/getWorkbench))
-	   browser
-	   (.createBrowser
-	      browser-support
-	      (reduce bit-or
-	        [IWorkbenchBrowserSupport/LOCATION_BAR
-	          IWorkbenchBrowserSupport/NAVIGATION_BAR
-	          IWorkbenchBrowserSupport/AS_EDITOR])
-	      nil "Labrepl" "Labrepl Instructions")]
-	   (.openURL browser (URL. (str "http://localhost:" *port*))))))
+  "Open a browser for the running labrepl web page"
+  [monitor]
+  (try
+    (.beginTask monitor "Opening Browser" IProgressMonitor/UNKNOWN)
+		(if (wait-for-resource check-server *timeout* *step* monitor)
+	   (let
+		  [browser-support (.getBrowserSupport (PlatformUI/getWorkbench))
+		   browser
+		   (.createBrowser
+		      browser-support
+		      (reduce bit-or
+		        [IWorkbenchBrowserSupport/LOCATION_BAR
+		          IWorkbenchBrowserSupport/NAVIGATION_BAR
+		          IWorkbenchBrowserSupport/AS_EDITOR])
+		      nil "Labrepl" "Labrepl Instructions")]
+		   (.openURL browser (URL. (str "http://localhost:" *port*)))
+	     Status/OK_STATUS)
+	     Status/CANCEL_STATUS)
+  (finally (.done monitor))))

 (defn- fix-libraries
   "Enter all the JAR files in the lib directory to the Java build path of the project"
@@ -189,23 +196,22 @@
           (let
             [startup-file-selection (StructuredSelection. (.getFile (.getFolder project "src") "labrepl.clj"))
               browser-labrepl-job
-                (proxy [UIJob] ["Start Labrepl Session and Browser"]
+                (proxy [WorkbenchJob] ["Start Labrepl Session and Browser"]
 			            (runInUIThread [monitor]
 			              (.launch (ClojureLaunchShortcut.) startup-file-selection ILaunchManager/RUN_MODE)
-										(let [console (wait-for-resource #(ClojureClient/findActiveReplConsole) *timeout* *step*)]
+										(let [console (wait-for-resource #(ClojureClient/findActiveReplConsole) *timeout* *step* monitor)]
                       (if console
                         (do
 	                        (EvaluateTextAction/evaluateText console "(labrepl/-main)")
-										      (open-browser)
-                          Status/OK_STATUS)
+										      (open-browser (SubProgressMonitor. monitor 5)))
                         Status/CANCEL_STATUS))))]
+            (.setUser browser-labrepl-job true)
             (.schedule browser-labrepl-job)))))))

 (defn -run
   [this monitor]
   (let
-    [monitor (if monitor monitor (NullProgressMonitor.))
-      state @(.state this)
+    [state @(.state this)
       page (:page state)
       overwrite-query (:overwrite-query state)]
     (try


cjl - Using dumb AI to generate commands

--- src/icfp2015/core.clj
+++ src/icfp2015/core.clj
@@ -1,8 +1,11 @@
 (ns icfp2015.core
   (:require [clojure.data.json :as json]
             [clojure.tools.cli :refer [parse-opts]]
-            [icfp2015.problem :refer [get-games]])
+            [icfp2015.problem :refer [get-games]]
+            [icfp2015.gameplay :refer [get-commands]])
   (:gen-class))
+
+(def dumb-ai (constantly [:move :southeast]))

 (defn read-games-from-file [f]
   (-> f
@@ -10,10 +13,19 @@
       (json/read-str :key-fn keyword)
       (get-games)))

+(defn command-to-letter [command]
+  (case
+    [:move :west] \p
+    [:move :east] \b
+    [:move :southwest] \a
+    [:move :southeast] \l
+    [:rotate :clockwise] \d
+    [:rotate :counterclockwise] \k))
+
 (defn solve-game [game]
   { :problemId (:problemId game)
     :seed (:seed game)
-    :solution (apply str (repeat 3 "a")) })
+    :solution (map command-to-letter (get-commands dumb-ai game)) })

 (def cli-options
   [["-f" "--file FILE" "Input filename"


send export-count to redis for averaging

--- src/luffer/worker.clj
+++ src/luffer/worker.clj
@@ -57,13 +57,14 @@

 (defn- print-work [worker-id [start-id stop-id :as work]]
   (if work
-    (println (format "worker %d exporting [%d,%d)" worker-id start-id stop-id))))
+    (println (format "worker %d exporting [%,d - %,d)" worker-id start-id stop-id))))

 (defn- do-work [i callback]
   (let [work (dequeue-work!)]
     (print-work i work)
     (if work
       (let [timing (secs (callback work))]
+        (wcar* (car/incr "export-count"))
         (wcar* (car/incrbyfloat "export-timing" timing)))
       (Thread/sleep 250)))
   nil)


renamed some vars, added comments

renamed some vars, added comments

--- src/memtest/core.cljs
+++ src/memtest/core.cljs
@@ -1,96 +1,121 @@
+; defines a memtest.core object
 (ns memtest.core
   (:require [reagent.core :as reagent :refer [atom]]))

 (enable-console-print!)

-(def gameboard (atom (sorted-map)))
-(def counter (atom 0))
-(def found (atom #{}))
-(def selected (atom nil))
-(def highlighted (atom #{}))
-(def colors
+(def colors ; colors match the cell number
   {1 "#677685", 2 "#FFB492", 3 "#8EE6CA", 4 "#92387E",
    5 "#FFF6C9", 6 "#5C58EB", 7 "#D1052D", 8 "#857A67"})

+; A gameboard is a grid of cells, each uniquely identified, but two cells will
+; have the same number and colors.  The game is won when all cells have been
+; matched
+
+(def counter (atom 0))              ; generates unique ids for each cell
+(def gameboard (atom (sorted-map))) ; gameboard is sorted to preserve cell order
+(def matched (atom #{}))            ; numbers that have been matched
+(def selected (atom nil))           ; cell that was last selected
+(def highlighted (atom #{}))        ; cells that are highlighted
+
 (defn won-game?
   []
-  (= (/ (count @gameboard) 2) (count @found)))
+  ; game is won when count of matches is equal to half of gameboard, because
+  ; cells contain duplicate numbers
+  (= (/ (count @gameboard) 2) (count @matched)))

-(defn add-piece [n]
+(defn add-cell [n]
+  ; add a numbered cell with a unique id
   (let [id (swap! counter inc)]
     (swap! gameboard assoc id {:id id :number n :color (colors n)})))

 (defn new-game
   []
+  ; game starts out with an empty board, no cell selected, nothing hilighted,
+  ; and no matches
   (reset! gameboard (sorted-map))
   (reset! selected nil)
-  (reset! found #{})
+  (reset! matched #{})
   (reset! highlighted #{})
+  ; take two sets of numbers (1..8) and randomize their order, then add them as
+  ; cells
   (doseq [x (shuffle (into (range 1 9) (range 1 9)))]
-    (add-piece x)))
+    (add-cell x)))

+; initialize the board
 (new-game)

-(defn select-piece
-  [piece]
-  (reset! highlighted #{})
-  (reset! selected piece))
+(defn select-cell
+  [cell]                   ; ensures one cell is colored via selection
+  (reset! highlighted #{}) ; dont highlight anything
+  (reset! selected cell))  ; mark cell as selected

-(defn lose-piece
-  [piece]
-  (reset! highlighted #{piece @selected})
-  (reset! selected nil))
+(defn lose-cell
+  [cell]                                 ; ensures two cells are colored via highlighting
+  (reset! highlighted #{cell @selected}) ; highlight selected and current cell
+  (reset! selected nil))                 ; dont select anything

-(defn win-piece
-  [{:keys [number]}]
-  (reset! selected nil)
-  (reset! highlighted #{})
-  (swap! found conj number))
+(defn win-cell
+  [{:keys [number]}]                     ; ensures two more cells are colored via match
+  (reset! selected nil)                  ; dont select anything
+  (reset! highlighted #{})               ; dont highlight anything
+  (swap! matched conj number))           ; mark number as matched

 (defn winning-click?
   [{:keys [number id]}]
-  (and (= (:number @selected) number)
-       (not= (:id @selected) id)))
+  (and (= (:number @selected) number) ; win if the number matched the selected cell
+       (not= (:id @selected) id)))    ; and if it's not the same selected cell

 (defn handle-click
-  [{:keys [number id] :as piece}]
+  [{:keys [number id] :as cell}]
   (cond
-   (= @selected piece) (reset! selected nil)
-   (nil? @selected) (select-piece piece)
-   (winning-click? piece) (win-piece piece)
-   :else (lose-piece piece)))
+   (= @selected cell) (reset! selected nil) ; reset if selected cell is selected again
+   (nil? @selected) (select-cell cell)      ; set as selected if nothing was selected
+   (winning-click? cell) (win-cell cell)    ; mark as won if click is a dinner
+   :else (lose-cell cell)))                 ; else mark as lost

 (defn highlighted?
-  [piece]
-  (or (get @found (:number piece))
-      (= @selected piece)
-      (get @highlighted piece)))
+  [cell]
+  (or (get @matched (:number cell)) ; color if number matched
+      (= @selected cell)            ;       if selected
+      (get @highlighted cell)))     ;       if highlighted

 (defn board-cell []
-  (fn [{:keys [number color id] :as piece}]
-    [:td {:class "game-piece"
-          :style (if (highlighted? piece) {:background-color color} {})
-          :on-click #(handle-click piece)}]))
+  (fn [{:keys [number color id] :as cell}]
+    ; display cell with background color
+    [:td {:class "game-cell"
+          :style (if (highlighted? cell) {:background-color color} {})
+          :on-click #(handle-click cell)}]))

 (defn board-row []
   (fn [x]
     [:tr
-     (for [{:keys [id] :as piece} x]
-       ^{:key id} [board-cell piece])]))
+     ; loop through each cell in a row
+     (for [{:keys [id] :as cell} x]
+       ^{:key id} [board-cell cell])]))

+; the top level component
 (defn board [props]
   (fn []
-    (let [items (vals @gameboard)]
+    (let [cells (vals @gameboard)]
       [:div#container
+       ; game title
        [:h1 "The memory game"]
+       ; win status
        [:h2 (if (won-game?) "You won!")]
+       ; the gameboard
        [:table#gameboard
+        ; taking 4 cells at a time for each row
         (map-indexed
          (fn [idx x] ^{:key idx} [board-row x])
-         (partition 4 items))]
+         (partition 4 cells))]
+       ; text link to reset the game
        [:p [:a {:class "new-game" :on-click #(new-game)
                 :href "#"} "New game"]]])))

+; this is how the game is started
+; exports a run function in the memtest.core object
 (defn ^:export run []
   (reagent/render-component [board]
                             (.-body js/document)))
+


Store played notes as on/off times w touch-id

* Only current note stored at the moment for each piano key.  But will allow note history in the future.

--- src/musicbox/one.cljs
+++ src/musicbox/one.cljs
@@ -30,16 +30,17 @@
                (center-dimension w-window w-text)
                (center-dimension h-window h-text))))
   (let [{w :w h :h} instrument
-        freqs (keys (:notes instrument))
+        freqs (keys (:piano-keys instrument))
         note-count (count freqs)
         note-width (/ w note-count)]
     (.clearRect draw-ctx 0 0 w h)
     (dotimes [n note-count]
-      (let [note-on (:touch-id (get (:notes instrument) (nth freqs n)))]
+      (let [note (first (:notes (get (:piano-keys instrument) (nth freqs n))))
+            note-on (and note (nil? (:off note)))]
         (set! (.-fillStyle draw-ctx)
               ((if note-on :dark :light)
-               (nth colors (mod n (count colors))))))
-      (.fillRect draw-ctx (* n note-width) 0 note-width h))))
+               (nth colors (mod n (count colors)))))
+        (.fillRect draw-ctx (* n note-width) 0 note-width h)))))

 (defn create-note-synth
   [freq]
@@ -49,10 +50,10 @@

 (defn create-instrument
   [scale]
-  {:notes (apply sorted-map
+  {:piano-keys (apply sorted-map
                  (flatten (map vector
                                scale
-                               (map (fn [x] {:synth (create-note-synth x) :touch-id nil})
+                               (map (fn [x] {:synth (create-note-synth x) :notes []})
                                     scale))))
    :w 0
    :h 0})
@@ -74,24 +75,26 @@
   (scales/quantize (get touch :clientX)
                    0
                    (:w instrument)
-                   (keys (:notes instrument))))
+                   (keys (:piano-keys instrument))))

 (def instrument-fns
   {"touchstart" (fn
-                  [instrument {touch-id :touch-id :as event}]
+                  [instrument {touch-id :touch-id time :time :as event}]
                   (let [freq (touch->freq instrument event)
-                        note (get (:notes instrument) freq)]
-                    (if (not (:touch-id note))
+                        piano-key (get (:piano-keys instrument) freq)]
+                    (if (empty? (:notes piano-key))
                       (do
-                        (.play (.bang (:synth note)))
-                        (assoc-in instrument [:notes freq :touch-id] touch-id)))))
+                        (.play (.bang (:synth piano-key)))
+                        (assoc-in instrument
+                                  [:piano-keys freq :notes]
+                                  [{:on time :off nil :touch-id touch-id}])))))
    "touchend" (fn
-                [{notes :notes :as instrument} {touch-id :touch-id :as event}]
-                (if-let [freq (first (filter (fn [x] (= touch-id (:touch-id (get notes x))))
-                                             (keys notes)))]
+                [{piano-keys :piano-keys :as instrument} {touch-id :touch-id :as event}]
+                (if-let [freq (first (filter (fn [x] (= touch-id (:touch-id (first (:notes (get piano-keys x))))))
+                                             (keys piano-keys)))]
                     (do
-                      (.release (:synth (get notes freq)))
-                      (assoc-in instrument [:notes freq :touch-id] nil))))})
+                      (.release (:synth (get piano-keys freq)))
+                      (assoc-in instrument [:piano-keys freq :notes] []))))})

 (defn fire-event-on-instrument
   [instrument event]


prettify print-classpath

prettify print-classpath

--- src/overtone/util.clj
+++ src/overtone/util.clj
@@ -3,8 +3,10 @@
      :author "Jeff Rose"}
   overtone.util
   (:require [overtone.log :as log])
+
   (:use clojure.contrib.def
-        clojure.stacktrace)
+        clojure.stacktrace
+        [clojure.pprint :as pprint])
   (:import (java.util ArrayList Collections)))

 ; Some generic counters
@@ -22,7 +24,9 @@
   (dosync (ref-set id-counters* {})))

 (defn print-classpath []
-  (println (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))
+  (let [paths (map (memfn getPath)
+                   (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))]
+    (pprint/pprint (sort paths))))

 (defn as-str [s]
   (if (keyword? s) (name s) s))


Cope with string values coming out of ES

--- app/pyrexia/src/pyrexia/core.cljs
+++ app/pyrexia/src/pyrexia/core.cljs
@@ -76,9 +76,9 @@
     (.log js/console "nodes" (pr-str nodes))
     (swap! c/app-state assoc node-key nodes)
     (swap! c/app-state assoc :nodes (merge (:old-nodes @c/app-state) (:new-nodes @c/app-state)))
-    (swap! c/app-state assoc :minValue (apply min-skip-null (map :temp (vals (:nodes @c/app-state)))))
+    (swap! c/app-state assoc :minValue (apply min-skip-null (map #(-> % :temp js/parseInt) (vals (:nodes @c/app-state)))))
     (.log js/console "minValue" (:minValue @c/app-state))
-    (swap! c/app-state assoc :maxValue (apply max (map :temp (vals (:nodes @c/app-state)))))
+    (swap! c/app-state assoc :maxValue (apply max (map #(-> % :temp js/parseInt) (vals (:nodes @c/app-state)))))
     (.log js/console "maxValue" (:maxValue @c/app-state))
     (map/draw-map map/canvas-dom (:map @c/app-state))))


Turn off right piano key when delete note.

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -125,7 +125,7 @@
   [instrument freq]
   (if (get-in instrument [:piano-keys freq :on?])
     (do
-      (println "stop" (get-in instrument [:piano-keys freq :synth]))
+      (println "stop")
       (.release (get-in instrument [:piano-keys freq :synth]))
       (assoc-in instrument [:piano-keys freq :on?] false))
     instrument))
@@ -197,7 +197,8 @@
                          (- (get-in instrument [:cur-touches (t :touch-id) :position :y])
                             (-> t :position :y)))
                        (filter-type "touchmove" touches))]
-    (first (sort (fn [a b] (max (.abs js/Math a) (.abs js/Math b))) distances))))
+    (or (first (sort (fn [a b] (max (.abs js/Math a) (.abs js/Math b))) distances))
+        0)))

 (defn record-touches
   [touches instrument]
@@ -211,24 +212,23 @@

 (defn scroll
   [touches {playhead :playhead :as instrument}]
-  (if-let [scroll-distance (max-scroll-distance touches instrument)]
-    (let [delta-y (/ scroll-distance (instrument :px-per-ms))]
+  (let [delta-ms (/ (max-scroll-distance touches instrument)
+                    (instrument :px-per-ms))]
+    (if (> (.abs js/Math delta-ms) 20)
       (-> instrument
           (assoc :scrolling? true)
-          (assoc :playhead (+ playhead delta-y))))
-    (assoc instrument :scrolling? false)))
+          (assoc :playhead (+ playhead delta-ms)))
+      (assoc instrument :scrolling? false))))

 (defn delete-scrolled-notes
   [touches {notes :notes :as instrument}]
-  (let [touchmoves (filter-type "touchmove" touches)
-        scroll-touch-ids (set (map :touch-id touchmoves))
-        scroll-touch-freqs (map (partial touch->freq instrument) touchmoves)]
+  (let [scroll-touch-ids (set (map :touch-id (filter-type "touchmove" touches)))
+        delete-notes (group-by (fn [t] (and (nil? (t :off))
+                                            (contains? scroll-touch-ids (t :touch-id))))
+                               notes)]
     (-> instrument
-        (assoc :notes (remove (fn [t]
-                                (and (nil? (t :off))
-                                     (contains? scroll-touch-ids (t :touch-id))))
-                              notes))
-        (->> (reduce-val->> stop-piano-key scroll-touch-freqs)))))
+        (assoc :notes (get delete-notes false))
+        (->> (reduce-val->> stop-piano-key (map :freq (get delete-notes true)))))))

 (defn handle-scrolling
   [touches instrument]


no longer need to prepare figwheel options

--- sidecar/src/figwheel_sidecar/components/figwheel_server.clj
+++ sidecar/src/figwheel_sidecar/components/figwheel_server.clj
@@ -245,13 +245,12 @@
         @default-handler)))

 (defn figwheel-server [figwheel-options all-builds]
-  (let [prepped-fig-options (config/prep-options figwheel-options)
-        all-builds          (map config/add-compiler-env (config/prep-builds all-builds))
+  (let [all-builds          (map config/add-compiler-env (config/prep-builds all-builds))
         all-builds (ensure-array-map all-builds)

-        initial-state       (create-initial-state prepped-fig-options)
+        initial-state       (create-initial-state figwheel-options)
         figwheel-opts (assoc initial-state
                              :builds all-builds
-                             :log-writer    (extract-log-writer prepped-fig-options)
-                             :cljs-build-fn (extract-cljs-build-fn prepped-fig-options))]
+                             :log-writer    (extract-log-writer figwheel-options)
+                             :cljs-build-fn (extract-cljs-build-fn figwheel-options))]
     (map->FigwheelServer figwheel-opts)))


:lipstick: Minor improvements on dropdown component.

--- frontend/src/uxbox/main/ui/components/dropdown.cljs
+++ frontend/src/uxbox/main/ui/components/dropdown.cljs
@@ -7,7 +7,7 @@
   (:import goog.events.EventType
            goog.events.KeyCodes))

-(mf/defrc dropdown'
+(mf/defrc dropdown-container
   [props]
   (let [children (gobj/get props "children")
         on-close (gobj/get props "on-close")
@@ -30,10 +30,10 @@
                (events/unlistenByKey lkey2))))]

     (mf/use-effect {:fn on-mount})
-    [:div.dropdown
-     children]))
+    children))

 (mf/defrc dropdown
   [props]
   (when (gobj/get props "show")
-    (mf/element dropdown' props)))
+    [:div.dropdown
+     (mf/element dropdown-container props)]))


better

better

--- exercism/clojure/leap/src/leap.clj
+++ exercism/clojure/leap/src/leap.clj
@@ -1,8 +1,9 @@
 (ns leap)

 (defn leap-year? [y]
-  (and
-    (zero? (mod y 4))
-    (or
-      (pos? (mod y 100))
-      (zero? (mod y 400)))))
+  (letfn [(div? [n d] (zero? (mod n d)))]
+    (cond
+      (div? y 400) true
+      (div? y 100) false
+      (div? y 4) true
+      :else false)))


Add CL option to run tests without booted servers.

--- test/run.clj
+++ test/run.clj
@@ -1,10 +1,12 @@
 (use 'clj-unit.core)

-(require 'fleetdb.server)
+(def base-tests ['fleetdb.compare-test
+                 'fleetdb.core-test
+                 'fleetdb.embedded-test])

-(require-and-run-tests
-  'fleetdb.compare-test
-  'fleetdb.core-test
-  'fleetdb.embedded-test
-  'fleetdb.server-test
-)
+(def server-test 'fleetdb.server-test)
+
+(apply require-and-run-tests
+  (if (= (first *command-line-args*) "--no-server")
+    base-tests
+    (conj base-tests server-test)))


added base transforms to server rendering

--- src/kioo/server/core.clj
+++ src/kioo/server/core.clj
@@ -1,6 +1,8 @@
 (ns kioo.server.core
   (:require [kioo.core :refer [component* snippet*]]
-            [kioo.util :refer [convert-attrs]]))
+            [kioo.util :refer [convert-attrs flatten-nodes]]
+            [net.cgrand.enlive-html :as enlive]
+            [kioo.common :as common]))

 (declare emit-node)

@@ -86,3 +88,41 @@

 (defmacro deftemplate [sym path args & trans]
   `(def ~sym ~(snippet* path trans args server-emit-opts)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TRANSFORMS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def content common/content)
+(def append common/append)
+(def prepend common/prepend)
+
+(defn after [& body]
+  (fn [node]
+    (cons node body)))
+
+(defn before [& body]
+  (fn [node]
+    (flatten-nodes (concat body [node]))))
+
+(def substitute common/substitute)
+(def set-attr common/set-attr)
+(def remove-attr common/remove-attr)
+(def do-> common/do->)
+(def set-style common/set-style)
+(def remove-style common/remove-style)
+(def set-class common/set-class)
+(def add-class common/add-class)
+(def remove-class common/remove-class)
+
+(defn wrap [tag attrs]
+  (fn [node]
+    {:tag tag
+     :attrs (convert-attrs attrs)
+     :content [(make-dom node)]}))
+
+(def unwrap common/unwrap)
+(def html enlive/html)
+(def html-content enlive/html-content)


wait for timeouts

wait for timeouts

--- src/evalback/core.clj
+++ src/evalback/core.clj
@@ -198,8 +198,10 @@
   (println :init))

 (defn destroy []
-  (doseq [_ (range instances)] ((:kill-fn ((<!! @worker) nil))))
+  (doseq [_ (range instances)]
+    ((:kill-fn ((<!! @worker) nil))))
   (reset! worker nil)
+  (Thread/sleep (* 3300 instances))
   (println :destroy))


Update parser.clj

Update parser.clj

--- src/falkor/parser.clj
+++ src/falkor/parser.clj
@@ -7,7 +7,8 @@
 ;; ****************************************************************

 (defn get-document
-  ""
+  "Retrieve a web page and cast it to a Document object.
+   TODO: Replace the HTTP element with an async HTTP client eventually"
   [url]
   (.get (org.jsoup.Jsoup/connect url)))


routing: fixed comments

routing: fixed comments

--- examples/_common/middleware/routing.cljs
+++ examples/_common/middleware/routing.cljs
@@ -9,9 +9,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;; History object deals with browser url bar
 (defprotocol HistoryProtocol
   (listen [this on-browser-event on-user-event]
-          "Starts calling back on navigation events. There are 2 types of events:
+          "Starts calling back on history events. There are 2 types of events:
             1) 'user' - initiated via this API;
-            2) 'browser' - e.g. changing hash or clicking forward/back buttons.
+            2) 'browser' - e.g. changing hash in url bar or clicking forward/back buttons.
           Fires the initial browser callback. Returns a function which stops listening.")
   (token [this] "Return current token.")
   (replace-token [this token] "Replace token firing user event.")
@@ -66,7 +66,7 @@

 ;;; Control
 (defn -wrap-control
-  "Updates token in model on navigation signal and lets wrapped app handle the signal."
+  "Updates token in model on history events and lets wrapped app handle the signal."
   [app-control]
   (fn control
     [model signal dispatch-signal dispatch-action]
@@ -97,10 +97,10 @@

 ;;; Middleware
 (defn add
-  "Routing middleware which allows app react to navigation events by observing model changes.
+  "Routing middleware which allows app react to history events by observing model changes.

   After start it begins catching browser history events and updates ::token in model accordingly.
-  Sends [::on-navigate token] signal to app on browser-initiated navigation events.
+  Sends [::on-navigate token] signal to app on browser-initiated history events.
   If ::token changes in model (e.g. by toggling action in debugger), then current url is updated using new token.
   App can set initial ::token in its initial-model."
   [spec history]


DM | Fix middleware wrappers; fix content type in WIP handler

--- src/freecoin/core.clj
+++ src/freecoin/core.clj
@@ -58,7 +58,7 @@
                  (routes/absolute-path config-m :sso-callback)))

 (defn todo [_]
-  {:status 200 :body "Work-in-progress"})
+  {:status 200 :body "Work-in-progress" :headers {"Content-Type" "text/html"}})

 (defn handlers [config-m stores-m blockchain]
   (let [wallet-store (storage/get-wallet-store stores-m)
@@ -86,7 +86,7 @@
   {:status 403 :body "CSRF token mismatch"})

 (defn wrap-defaults-config [session-store secure?]
-  (-> (if secure? (ring-mw/secure-site-defaults :proxy true) ring-mw/site-defaults)
+  (-> (if secure? (assoc ring-mw/secure-site-defaults :proxy true) ring-mw/site-defaults)
       (assoc-in [:session :cookie-name] "freecoin-session")
       (assoc-in [:session :store] session-store)
       (assoc-in [:security :anti-forgery] {:error-handler handle-anti-forgery-error})))
@@ -124,7 +124,7 @@
         (assoc app-state :server server)))))

 (defn halt [app-state]
-  (when-let [server (app-state)]
+  (when-let [server (:server app-state)]
     (server))
   (dissoc app-state :server))


Fix board map in change notifications.

Fix board map in change notifications.

--- src/oc/storage/async/notification.clj
+++ src/oc/storage/async/notification.clj
@@ -125,7 +125,7 @@
   ([notification-type content user] (->trigger notification-type nil nil content user nil nil))
   ([notification-type org content user] (->trigger notification-type org nil content user nil nil))
   ([notification-type org content user note] (->trigger notification-type org nil content user note nil))
-  ([notification-type org board content user note] (->trigger notification-type org nil content user note nil))
+  ([notification-type org board content user note] (->trigger notification-type org board content user note nil))
   ([notification-type org board content user note ws-client-id]
   (let [notice {:notification-type notification-type
                 :resource-type (resource-type (or (:old content) (:new content)))


first commit for homepage's 4th section

first commit for homepage's 4th section

--- frontend/components/landing-b.cljs
+++ frontend/components/landing-b.cljs
@@ -39,7 +39,7 @@
                    (common/ico :logo)]]]
                 [:div.prolog-slogans
                  [:h1.slogan.proverb {:title "Your org needs a hero."
-                                      :alt   "Just gotta authorize first."}
+                                      :alt   "Let's just authorize first."}
                   "Your org needs a hero."]
                  [:h3.slogan.context {:title "You have a product to focus on, let Circle handle your "
                                       :alt   "Signing up using your GitHub login lets us start really fast."}
@@ -52,11 +52,11 @@
                   "Learn more"
                   (common/ico :chevron-down)]]]
                [:section.home-purpose
-                [:div.purpose-drawings
+                [:div.home-drawings
                  [:div.drawing]
                  [:div.drawing]
                  (om/build drawings/drawing-dashboard app)]
-                [:div.purpose-articles
+                [:div.home-articles
                  [:article
                   [:h1
                    "Launches are dead,"
@@ -96,5 +96,20 @@
                    (om/build drawings/customer-logo-square app)
                    (om/build drawings/customer-logo-newrelic app)
                    (om/build drawings/customer-logo-spotify app)]]]]
-               [:section.home-potential]
+               [:section.home-potential
+                [:div.home-articles
+                 [:article
+                  [:h1
+                   "Look under the hood & you'll"
+                   [:br]
+                   " find our best bullet points."]
+                  [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed tempus felis quis dictum mollis. Vivamus non tempor diam. Maecenas sagittis condimentum sapien. Ut sed gravida augue. Proin elementum molestie feugiat. Etiam finibus, neque a consectetur ultrices, tortor ligula blandit mi, ac ornare nisi felis ac dui. Fusce porta vel nunc sed commodo. Praesent bibendum ex hendrerit, bibendum elit et, egestas arcu."]
+                  [:p
+                   [:a.shopify-link
+                    "See how Shopify does it"
+                    (common/ico :slim-arrow-right)]]]]
+                [:div.home-drawings
+                 [:div.drawing]
+                 [:div.drawing]
+                 (om/build drawings/drawing-dashboard app)]]
                [:section.home-epilog]])))))


fix typo

fix typo

--- src/metabase/api/org.clj
+++ src/metabase/api/org.clj
@@ -22,8 +22,8 @@
   {name [Required NonEmptyString]
    slug [Required NonEmptyString]} ; TODO - check logo_url ?
   (check-superuser)
-  (let-500 [{:keys [id] As new-org} (->> (util/select-non-nil-keys body :slug :name :description :logo_url)
-                                         (mapply ins Org))]
+  (let-500 [{:keys [id] :as new-org} (->> (util/select-non-nil-keys body :slug :name :description :logo_url)
+                                          (mapply ins Org))]
     (grant-org-perm id *current-user-id* true) ; now that the Org exists, add the creator as the first admin member
     new-org))                                  ; make sure the api response is still the newly created org


use sessionStorage for circle-state

use sessionStorage for circle-state

--- frontend/controllers/controls.cljs
+++ frontend/controllers/controls.cljs
@@ -95,7 +95,7 @@

 (defmethod control-event :state-restored
   [target message path state]
-  (let [str-data (.getItem js/localStorage "circle-state")]
+  (let [str-data (.getItem js/sessionStorage "circle-state")]
     (if (seq str-data)
       (-> str-data
           reader/read-string
@@ -281,7 +281,7 @@

 (defmethod post-control-event! :state-persisted
   [target message channel-id previous-state current-state]
-  (.setItem js/localStorage "circle-state"
+  (.setItem js/sessionStorage "circle-state"
             (pr-str (dissoc current-state :comms))))


Use same context

Use same context

--- src/nightmod/sandbox.clj
+++ src/nightmod/sandbox.clj
@@ -2,7 +2,8 @@
   (:require [clojail.core :as jail]
             [clojail.testers :as jail-test]
             [clojure.java.io :as io]
-            [nightmod.utils :as u]))
+            [nightmod.utils :as u])
+  (:import [java.security AccessController]))

 (def tester
   [(jail-test/blacklist-objects
@@ -25,6 +26,7 @@
    (jail-test/blanket "clojail")])

 (def sb (jail/sandbox tester
+                      :context (AccessController/getContext)
                       :timeout 5000
                       :namespace 'nightmod.game
                       :init '(require '[nightmod.public :refer :all]


CMR-1188: Replaced are with are2 in the unit tests

--- spatial-lib/test/cmr/spatial/test/tile.clj
+++ spatial-lib/test/cmr/spatial/test/tile.clj
@@ -6,7 +6,8 @@
      		    [cmr.spatial.derived :as d]
             [cmr.spatial.point :as p]
             [cmr.spatial.mbr :as m]
-            [cmr.spatial.line-string :as l]))
+            [cmr.spatial.line-string :as l]
+            [cmr.common.util :as u]))

 (deftest modis-tile-coordinates
   (testing "creation and retrieval of modis tile coordinates"
@@ -22,44 +23,44 @@

 (deftest modis-search-overalapping-tiles
   (testing "find all the tiles which intersect the given geometry"
-    (are [geom tiles] (= (set tiles) (set (t/geometry->tiles geom)))
+    (u/are2 [geom tiles] (= (set tiles) (set (t/geometry->tiles geom)))

-         ;; A large bounding box near the equator
+         "A large bounding box near the equator"
          (d/calculate-derived (m/mbr -20 20 20 -20))
          [[15 8] [15 9] [16 6] [16 7] [16 8] [16 9] [16 10] [16 11] [17 6] [17 7] [17 8] [17 9]
           [17 10] [17 11] [18 6] [18 7] [18 8] [18 9] [18 10] [18 11] [19 6] [19 7] [19 8] [19 9]
           [19 10] [19 11] [20 8] [20 9]]

-         ;; A small geodetic ring completely inside a tile
+         "A small geodetic ring completely inside a tile"
          (d/calculate-derived (rr/ords->ring :geodetic -77.205, 39.112, -77.188, 39.134, -77.221,
                                             39.143, -77.252, 39.130, -77.250,39.116,-77.205,39.112))
          [[12 5]]

-         ;; A point
+         "A point"
          (p/point -84.2625 36.0133)
          [[11 5]]

-         ;;Geodetic line string
+         "Geodetic line string"
          (l/ords->line-string :geodetic 1 1, 10 5, 15 9)
          [[18 8][19 8]]

-         ;;A narrow bounding box crossing over two tiles
+         "A narrow bounding box crossing over two tiles"
          (m/mbr -0.01 15.0 0.01 5.0)
          [[17 7][17 8][18 7][18 8]]

-         ;; North Pole
+         "North Pole"
          p/north-pole
          [[17 0] [18 0]]

-         ;;South Pole
+         "South Pole"
          p/south-pole
          [[17 17][18 17]]

-         ;;Bounding box crossing anti-meridian
+         "Bounding box crossing anti-meridian"
          (m/mbr 178.16 1.32 -176.79 -4.19)
          [[0 8][0 9][35 8][35 9]]

-         ;;whole world
+         "Whole world"
          (m/mbr -180 90 180 -90)
          (map :coordinates t/modis-sin-tiles)
     )))


insights: make mid grid-line always in middle

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -125,16 +125,15 @@
                                   builds))
         y-neg-max (apply max (map :queued_time_millis
                                   builds))
-        y-zero (* (:height plot-info) (:positive-y% plot-info))
+        y-zero (apply * ((juxt :height :positive-y%) plot-info))
         y-pos-scale (-> (js/d3.scale.linear)
                         (.domain #js[0 y-pos-max])
                         (.range #js[y-zero 0]))
         y-neg-scale (-> (js/d3.scale.linear)
                         (.domain #js[0 y-neg-max])
                         (.range #js[y-zero (:height plot-info)]))
-        y-pos-tick-values `(~@(map datetime/nice-floor-duration
-                                   [y-pos-max (* y-pos-max 0.5)])
-                            0)
+        y-pos-floored-max (datetime/nice-floor-duration y-pos-max)
+        y-pos-tick-values (list y-pos-floored-max (/ y-pos-floored-max 2) 0)
         y-neg-tick-values [(datetime/nice-floor-duration y-neg-max)]
         y-pos-axis (-> (js/d3.svg.axis)
                        (.scale y-pos-scale)
@@ -149,7 +148,7 @@
         scale-filler (map (partial str "xx-") (range (- (:max-bars plot-info) (count builds))))
         x-scale (-> (js/d3.scale.ordinal)
                     (.domain (clj->js
-                              `(~@(map :build_num builds) ~@scale-filler)))
+                              (concat (map :build_num builds) scale-filler)))
                     (.rangeBands #js[0 (:width plot-info)] 0.5))
         plot (-> js/d3
                 (.select el)


Add inactive tests for all node modification fns.

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -13,7 +13,7 @@

 (defonce ^{:dynamic true} *inactive-node-modification-error* :exception)

-(defn inactive-node-modification-error
+(defn- inactive-node-modification-error
   "The default error behaviour triggered when a user attempts to either
   control or kill an inactive node."
   [err-msg]
@@ -192,16 +192,22 @@
   (or (node-live? n)
       (node-loading? n)))

+(defn- ensure-node-active!
+  ([node] (ensure-node-active! "Trying to modify an inactive node."))
+  ([node err-msg]
+     (when (and (node? node)
+                (not (node-active? node)))
+      (inactive-node-modification-error err-msg))))
+
+
 (defn node-free*
   "Free the specified nodes on the server. The allocated id is
   subsequently freed from the allocator via a callback fn listening
   for /n_end which will call node-destroyed."
   [node]
   {:pre [(server-connected?)]}
-  (if (node-active? node)
-    (snd "/n_free" (to-synth-id node))
-    (inactive-node-modification-error
-     (str "Trying to free a synth node that has been destroyed: " node)))
+  (ensure-node-active! node "Trying to free a synth node that has been destroyed")
+  (snd "/n_free" (to-synth-id node))
   node)

 (defn- node-destroyed
@@ -327,34 +333,37 @@
   "Pause a running synth node."
   [node]
   (ensure-connected!)
-  (snd "/n_run" (to-synth-id node) 0))
+  (ensure-node-active! node "Attempting to pause a node that has been destroyed.")
+  (snd "/n_run" (to-synth-id node) 0)
+  node)

 (defn node-start*
   "Start a paused synth node."
   [node]
   (ensure-connected!)
-  (snd "/n_run" (to-synth-id node) 1))
+  (ensure-node-active! node "Attempting to start a node that has been destroyed.")
+  (snd "/n_run" (to-synth-id node) 1)
+  node)

 (defn node-place*
   "Place a node :before or :after another node."
   [node position target]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to relocate a node that has been destroyed.")
   (let [node-id   (to-synth-id node)
         target-id (to-synth-id target)]
     (cond
       (= :before position) (snd "/n_before" node-id target-id)
-      (= :after  position) (snd "/n_after" node-id target-id))))
+      (= :after  position) (snd "/n_after" node-id target-id))
+    node))

 (defn node-control*
   "Set control values for a node."
   [node name-values]
   (ensure-connected!)
-  (let [node-id (to-synth-id node)]
-    (if (node-active? node)
-      (apply snd "/n_set" node-id (floatify (stringify (bus->id name-values))))
-      (inactive-node-modification-error
-       (str "Trying to control a synth node that has been destroyed: " node)))
-    node))
+  (ensure-node-active! node "Attempting to control a node that has been destroyed.")
+  (apply snd "/n_set" (to-synth-id node) (floatify (stringify (bus->id name-values))))
+  node)

 (defn node-get-control
   "Get one or more synth control values by name.  Returns a map of
@@ -363,6 +372,7 @@
   {:freq 440.0 :attack 0.2}"
   [node names]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to get control values of a node that has been destroyed.")
   (let [res   (recv "/n_set")
         cvals (do (apply snd "/s_get" (to-synth-id node) (stringify names))
                   (:args (deref! res)))]
@@ -374,14 +384,17 @@
   all nodes in the group."
   [node ctl-start ctl-vals]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to control a node that has been destroyed.")
   (let [node-id (to-synth-id node)]
-    (apply snd "/n_setn" node-id ctl-start (count ctl-vals) ctl-vals)))
+    (apply snd "/n_setn" node-id ctl-start (count ctl-vals) ctl-vals))
+  node)

 (defn node-get-control-range
   "Get a range of n controls starting at a given name or index.
   Returns a vector of values."
   [node name-index n]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to access a node that has been destroyed.")
   (let [res   (recv "/n_setn")
         cvals (do (snd "/s_getn" (to-synth-id node) (to-str name-index) n)
                   (:args (deref! res)))]
@@ -399,57 +412,71 @@
   "Connect a node's controls to a control bus."
   [node names-busses]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to map the controls of a node that has been destroyed.")
   (let [node-id      (to-synth-id node)
         names-busses (bussify (stringify names-busses))]
-    (apply snd "/n_map" node-id names-busses)))
+    (apply snd "/n_map" node-id names-busses))
+  node)

 (defn node-map-n-controls*
   "Connect N controls of a node to a set of sequential control busses,
   starting at the given control name."
   [node start-control start-bus n]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to map the controls of a node that has been destroyed.")
   (assert (bus? start-bus) "Invalid start-bus")
   (let [node-id (to-synth-id node)]
-    (snd "/n_mapn" node-id (first (stringify [start-control])) (bus-id start-bus) n)))
+    (snd "/n_mapn" node-id (first (stringify [start-control])) (bus-id start-bus) n))
+  node)

 (defn- group-post-tree*
   "Posts a representation of this group's node subtree, i.e. all the
   groups and synths contained within it, optionally including the
   current control values for synths."
-  [id with-args?]
-  (ensure-connected!)
-  (snd "/g_dumpTree" id with-args?))
+  [node with-args?]
+  (ensure-connected!)
+  (ensure-node-active! node "Attempting to view a node that has been destroyed.")
+  (snd "/g_dumpTree" (to-synth-id node) with-args?)
+  node)

 (defn- group-prepend-node*
   "Add a synth node to the end of a group list."
   [group node]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to move a node that has been destroyed.")
+  (ensure-node-active! group "Attempting to use a node that has been destroyed.")
   (let [group-id (to-synth-id group)
         node-id  (to-synth-id node)]
-    (snd "/g_head" group-id node-id)))
+    (snd "/g_head" group-id node-id))
+  group)

 (defn- group-append-node*
   "Add a synth node to the end of a group list."
   [group node]
   (ensure-connected!)
+  (ensure-node-active! node "Attempting to move a node that has been destroyed.")
+  (ensure-node-active! group "Attempting to move a node that has been destroyed.")
   (let [group-id (to-synth-id group)
         node-id  (to-synth-id node)]
-    (snd "/g_tail" group-id node-id)))
+    (snd "/g_tail" group-id node-id))
+  group)

 (defn- group-clear*
   "Free all child synth nodes in a group."
   [group]
   (ensure-connected!)
+  (ensure-node-active! group "Attempting to clear a node that has been destroyed.")
   (snd "/g_freeAll" (to-synth-id group))
-  :clear)
+  group)

 (defn- group-deep-clear*
   "Free all child synth nodes in and below this group in other child
   groups."
   [group]
   (ensure-connected!)
+  (ensure-node-active! group "Attempting to deep clear a node that has been destroyed.")
   (snd "/g_deepFree" (to-synth-id group))
-  :clear)
+  group)

 (extend java.lang.Long
   ISynthNode
@@ -619,10 +646,11 @@
   "Returns a data structure representing the current arrangement of
   groups and synthesizer instances residing on the audio server."
   ([] (group-node-tree* 0))
-  ([id & [ctls?]]
+  ([node & [ctls?]]
      (ensure-connected!)
+     (ensure-node-active! node "Attempting to view a node that has been destroyed.")
      (let [ctls? (if (or (= 1 ctls?) (= true ctls?)) 1 0)
-           id    (to-synth-id id)]
+           id    (to-synth-id node)]
        (let [reply-p (recv "/g_queryTree.reply")
              _       (snd "/g_queryTree" id ctls?)
              tree    (:args (deref! reply-p))]


bug fix

bug fix

--- src/pe_fp_app/config.clj
+++ src/pe_fp_app/config.clj
@@ -165,9 +165,11 @@
                              subname-prefix)
                   :user fp-db-username
                   :password fp-db-password}]
-     (j/with-db-connection [con-db db-spec]
-       (let [jdbc-conn (:connection con-db)]
-         (.addDataType jdbc-conn "geometry" org.postgis.PGgeometry)))
+     ; only do the following when db-name was explicitly provided
+     (when db-name
+       (j/with-db-connection [con-db db-spec]
+         (let [jdbc-conn (:connection con-db)]
+           (.addDataType jdbc-conn "geometry" org.postgis.PGgeometry))))
      db-spec)))

 (def db-spec-without-db (db-spec-fn nil))