Clean up unused requires in nrepl.handler

--- lein-light-nrepl/src/lighttable/nrepl/handler.clj
+++ lein-light-nrepl/src/lighttable/nrepl/handler.clj
@@ -1,16 +1,12 @@
 (ns lighttable.nrepl.handler
-  (:require [clojure.tools.nrepl.server :refer [start-server stop-server default-handler]]
-            [clojure.tools.nrepl.transport :as transport]
-            [clojure.tools.nrepl.middleware.session :refer [session]]
+  (:require [clojure.tools.nrepl.middleware.session :refer [session]]
             [clojure.tools.nrepl.middleware.interruptible-eval :refer [interruptible-eval *msg*]]
-            [clojure.tools.nrepl.misc :refer [response-for returning]]
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
             [lighttable.nrepl.core :as core]
             [lighttable.nrepl.eval :as eval]
             [lighttable.nrepl.cljs :as cljs]
             [lighttable.nrepl.doc :as doc]
-            lighttable.nrepl.auto-complete
-            [clojure.repl :as repl]))
+            lighttable.nrepl.auto-complete))

 (defn with-lt-data [msg]
   (if (or (not (:data msg))


Code optimization

Code optimization

--- src/whisper2cyanite/cli.clj
+++ src/whisper2cyanite/cli.clj
@@ -69,6 +69,21 @@
                [(format "Option \"--%s\" conflicts with the command \"%s\""
                         (name option) command)])))))

+(defn- prepare-common-args
+  "Prepare common arguments."
+  [arguments options]
+  (let [source (nth arguments 0)
+        tenant (nth arguments 1)
+        cass-hosts (str/split (nth arguments 2) #",")
+        es-url (nth arguments 3)
+        rollups (->> (:rollups options [])
+                     (filter #(not (nil? %)))
+                     (flatten)
+                     (apply hash-map))
+        options (assoc options :rollups rollups)]
+    {:source source :tenant tenant :cass-hosts cass-hosts :es-url es-url
+     :options options}))
+
 (defn- run-migrate
   "Run command 'migrate'."
   [command arguments options summary]
@@ -80,16 +95,9 @@
                            :disable-path-store :log-file :log-level
                            :disable-log :stop-on-error :disable-progress}
                  options)
-  (let [source (nth arguments 0)
-        tenant (nth arguments 1)
-        cass-hosts (str/split (nth arguments 2) #",")
-        es-url (nth arguments 3)
-        rollups (->> (:rollups options [])
-                     (filter #(not (nil? %)))
-                     (flatten)
-                     (apply hash-map))]
-    (core/migrate source tenant cass-hosts es-url
-                  (assoc options :rollups rollups))))
+  (let [{:keys [source tenant cass-hosts es-url
+                options]} (prepare-common-args arguments options)]
+    (core/migrate source tenant cass-hosts es-url options)))

 (defn- run-validate
   "Run command 'validate'."
@@ -101,16 +109,9 @@
                            :disable-path-store :log-file :log-level
                            :disable-log :stop-on-error :disable-progress}
                  options)
-  (let [source (nth arguments 0)
-        tenant (nth arguments 1)
-        cass-hosts (str/split (nth arguments 2) #",")
-        es-url (nth arguments 3)
-        rollups (->> (:rollups options [])
-                     (filter #(not (nil? %)))
-                     (flatten)
-                     (apply hash-map))]
-    (core/validate source tenant cass-hosts es-url
-                   (assoc options :rollups rollups))))
+  (let [{:keys [source tenant cass-hosts es-url
+                options]} (prepare-common-args arguments options)]
+    (core/validate source tenant cass-hosts es-url options)))

 (defn- run-list
   "Run command 'list'."


Version 0.3.5

Version 0.3.5

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.3.5-SNAPSHOT"
+(defproject metlog-vault "0.3.5"
   :description "Repository for long term storage of series data."

   :license {:name "Eclipse Public License"


string -> IFn bug

string -> IFn bug

--- src/clojure/zensols/model/execute_classifier.clj
+++ src/clojure/zensols/model/execute_classifier.clj
@@ -332,7 +332,7 @@
                       (format "%s-predictions.xls" (:name model)))]
     (-> (excel/build-workbook
          (excel/workbook-hssf)
-         {(format ("%s Predictions" (str/capitalize (:name model))))
+         {(format "%s Predictions" (str/capitalize (:name model)))
           (->> data
                (map (fn [row]
                       (map #(get row %) columns)))


Rewrite HTML rendering rule with Hiccup

Rewrite HTML rendering rule with Hiccup

--- src/leiningen/highlight/rendering_rules/html.clj
+++ src/leiningen/highlight/rendering_rules/html.clj
@@ -1,18 +1,19 @@
 (ns leiningen.highlight.rendering-rules.html
-  (:require [clojure.string :as str]))
+  (:require [hiccup.core :as hiccup]
+            [clojure.string :as str]))

-(defn- wrap-span [classes content]
-  (if (coll? classes)
-    (let [classes (str/join \space classes)]
-      (format "%s" classes content))
-    (format "%s" classes content)))
+(defn- wrap-span [classes attrs content]
+  (let [classes (str/join \space classes)]
+    (hiccup/html
+      [:span (merge {:class classes} attrs) content])))

 (defn- var-link [var content]
   (let [m (meta var)]
-    (format "%s" (str (:ns m)) (:name m) content)))
+    [:a {:href (format "/ns/%s#%s" (str (:ns m)) (:name m))}
+     content]))

-(defn- symbol-class [x]
-  (str "sym__" x))
+(defn- symbol-attr [x]
+  {:data-symbol x})

 (defn ^:private colorful-symbol [x v]
   (when-let [info (some-> x :symbol-info)]
@@ -20,22 +21,23 @@
       (case type
         "local"
         #_=> (if (= (:usage info) :def)
-               (->> (format "%s" (:id x) v)
-                    (wrap-span [type (symbol-class (:id x))]))
-               (->> (format "%s" (:binding info) v)
-                    (wrap-span [type (symbol-class (:binding info))])))
+               (wrap-span [type "def"] (symbol-attr (:id x))
+                          [:a {:name (:id x)} v])
+               (wrap-span [type] (symbol-attr (:binding info))
+                          [:a {:href (str "#" (:binding info))} v]))
         "var"
-        #_=> (->> (if (= (:usage info) :def)
-                    (format "%s" (:name info) v)
-                    (var-link (:var info) v))
-                  (wrap-span [type (symbol-class (name v))]))
+        #_=> (if (= (:usage info) :def)
+               (wrap-span [type "def"] (symbol-attr (:name info))
+                          [:a {:name (:name info)} v])
+               (wrap-span [type] (symbol-attr v)
+                          (var-link (:var info) v)))
         "macro"
-        #_=> (wrap-span [type (symbol-class (:macro info))]
+        #_=> (wrap-span [type] (symbol-attr (:macro info))
                         (var-link (:macro info) v))
-        #_else (wrap-span type v)))))
+        #_else (wrap-span [type] {} v)))))

 (def colorful-symbols-rule
   {:symbol {:content colorful-symbol}})

 (def keyword-rule
-  {:keyword {:content (fn [x v] (wrap-span "keyword" v))}})
+  {:keyword {:content (fn [x v] (wrap-span ["keyword"] {} v))}})


feat(aoc): add function for day4 part1

feat(aoc): add function for day4 part1

--- clojure/adventofcode/src/adventofcode/days/day4.clj
+++ clojure/adventofcode/src/adventofcode/days/day4.clj
@@ -27,4 +27,6 @@
 (defn rooms [path]
   (line-seq (io/reader path)))

-(reduce + (map sector-value (rooms "././files/day4_input.txt")))
+(defn part1
+  []
+  (reduce + (map sector-value (rooms "././files/day4_input.txt"))))


update screen import

update screen import

--- util/clojure-cli/src/commcare_cli/app_host.clj
+++ util/clojure-cli/src/commcare_cli/app_host.clj
@@ -9,7 +9,8 @@
            [org.commcare.data.xml DataModelPullParser]
            [org.commcare.session SessionFrame]
            [org.commcare.util CommCareConfigEngine]
-           [org.commcare.util.cli ApplicationHost MenuScreen EntityScreen]
+           [org.commcare.util.cli ApplicationHost]
+           [org.commcare.util.screen MenuScreen EntityScreen]
            [org.commcare.util.mocks CLISessionWrapper MockUserDataSandbox]
            [org.javarosa.core.util.externalizable LivePrototypeFactory]
            [org.javarosa.core.services.locale Localization]


show error when the user tries to add a sub-location of an existing location

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -280,22 +280,30 @@
             (recur parent-loc)))))))

 (defn add-location [location]
-  (dosync
-    (if (some #{true}
-              (map #(super-location? location %) @current-locations))
-      nil
-      (do (doseq [old-loc @current-locations]
-            (if (super-location? old-loc location)
-              (remove-location old-loc)))
-            (alter current-locations conj location))))
-  (.put pending-locations location)
-  (set-browser-status "Scanning")
-  (awt-event (-> @settings-window :locations :table .getModel .fireTableDataChanged)))
+  (if
+    (dosync
+      (if (some #{true}
+                (map #(super-location? location %) @current-locations))
+        nil
+        (do (doseq [old-loc @current-locations]
+              (if (super-location? old-loc location)
+                (remove-location old-loc)))
+              (alter current-locations conj location))))
+    (do
+      (.put pending-locations location)
+      (set-browser-status "Scanning")
+      (awt-event (-> @settings-window :locations :table .getModel .fireTableDataChanged))
+      true)
+    false))

 (defn user-add-location []
   (when-let [loc (choose-directory nil
                      "Please add a location to scan for Micro-Manager image sets.")]
-    (add-location (.getAbsolutePath loc))))
+    (when-not (add-location (.getAbsolutePath loc))
+      (JOptionPane/showMessageDialog
+        (@settings :frame) "This new location cannot be added because it is already
+inside an existing location in your collection."
+        (.getAbsolutePath loc) JOptionPane/INFORMATION_MESSAGE))))

 (defn get-display-index [table index]
   (let [column-model (.getColumnModel table)]


CMR-5391: Remove reference to spatial-viz library from system-int-test

--- system-int-test/project.clj
+++ system-int-test/project.clj
@@ -57,7 +57,6 @@
       :exclusions [
         [org.clojure/tools.nrepl]]
       :dependencies [
-        [nasa-cmr/cmr-vdd-spatial-viz "0.1.0-SNAPSHOT"]
         [org.clojars.gjahad/debug-repl "0.3.3"]
         [org.clojure/tools.namespace "0.2.11"]
         [org.clojure/tools.nrepl "0.2.13"]


PDOK-1599: analyse failed tests

PDOK-1599: analyse failed tests

--- src/test/clojure/pdok/featured/extracts_test.clj
+++ src/test/clojure/pdok/featured/extracts_test.clj
@@ -24,7 +24,9 @@

 (deftest test-rendered-feature-gml
   (let [[error features-for-extract] (features-for-extract "test" "dummy" "gml2extract" (one-feature) "src/test/resources/templates")
-        [tiles result-feature] (first features-for-extract)]
+        _ (println features-for-extract)
+        [tiles result-feature] (first features-for-extract)
+        _ (println result-feature)]
     (is (boolean (re-find #"<geo><gml:Polygon" result-feature)))
     (is (boolean (re-find #"<naam>PDOK</naam>" result-feature)))))


Very messy implementation of springy hinges.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -14,22 +14,22 @@
         ))

 (def my-code-url "https://github.com/pauldoo/scratch/blob/master/ClojureScript/hello.cljs")
-(def tick-step (/ 1 200))
-(def render-step (/ 1 30))
-(def gravity-strength 500)
-(def ground-strength 200)
+(def tick-step (/ 1 100))
+(def render-step (/ 1 25))
+(def gravity-strength 300)
+(def ground-strength 100)
 (def initial-game-state {
     :nodes {
         :t {
+            :pos [50 100]
+            :vel [0 0]
+        }
+        :u {
+            :pos [250 200]
+            :vel [0 0]
+        }
+        :v {
             :pos [150 100]
-            :vel [0 0]
-        }
-        :u {
-            :pos [350 200]
-            :vel [0 0]
-        }
-        :v {
-            :pos [250 100]
             :vel [0 0]
         }
     }
@@ -40,19 +40,29 @@
             :rest-length 224.0
             :strength 2000
         }
-        {
-            :node-a :u
-            :node-b :v
-            :rest-length 141.0
-            :strength 2000
-        }
+        ;{
+        ;    :node-a :u
+        ;    :node-b :v
+        ;    :rest-length 141.0
+        ;    :strength 2000
+        ;}
         {
             :node-a :t
             :node-b :v
             :rest-length 100.0
             :strength 2000
         }
-    ] })
+    ]
+    :hinges [
+        {
+            :node-a :u
+            :node-b :t
+            :node-c :v
+            :rest-angle (/ Math/PI 2)
+            :strength 100000
+        }
+    ]
+    })

 (defn print-to-log [v]
     (.log js/console v))
@@ -63,6 +73,13 @@
 (def magnitude-squared (comp (partial apply +) (partial map #(* % %))))
 (def magnitude (comp Math/sqrt magnitude-squared))
 (def normalize (comp (partial apply vec*) (juxt identity (comp (partial / 1.0) magnitude))))
+(defn dot-product [v w] (apply + (map * v w)))
+(defn clamp [v lower upper] (Math/min (Math/max v lower) upper))
+(defn angle [v w] (Math/acos (clamp
+    (dot-product (normalize v) (normalize w))
+    -1.0 1.0 )))
+(defn rot-cw [[x y]] [y (- x)])
+(defn rot-ccw [[x y]] [(- y) x])

 (defn calculate-force [node-a node-b rest-length strength]
     (let [a-b (vec- node-a node-b)
@@ -84,6 +101,31 @@
                         node-b-id (vec- (get forces node-b-id [0 0]) force))
                     r)))))

+(defn calculate-hinge-force [a b c rest-angle strength]
+    (let [
+        b-to-a (vec- a b)
+        b-to-c (vec- c b)
+        pressure (* (- rest-angle (angle b-to-a b-to-c)) strength)
+        result [
+            (vec* (rot-ccw b-to-a) (/ pressure (magnitude-squared b-to-a)))
+            (vec* (rot-cw b-to-c) (/ pressure (magnitude-squared b-to-c)))
+        ]]
+            result))
+
+(defn calculate-hinge-forces [nodes hinges]
+    (loop [forces {} hinges hinges]
+        (if (empty? hinges) forces
+            (let [
+                [h & r] hinges
+                {:keys [node-a node-b node-c rest-angle strength]} h
+                [force-a force-c] (calculate-hinge-force (:pos (nodes node-a)) (:pos (nodes node-b)) (:pos (nodes node-c)) rest-angle strength)]
+                    (recur
+                        (assoc forces
+                            node-a (vec+ (get forces node-a [0 0]) force-a)
+                            node-b (vec+ (get forces node-b [0 0]) (vec* (vec+ force-a force-c) -1.0))
+                            node-c (vec+ (get forces node-c [0 0]) force-c))
+                        r)))))
+
 (defn calculate-gravity-forces [nodes]
     (zipmap (keys nodes) (repeat [0 (- gravity-strength)])))

@@ -94,9 +136,10 @@
                 (vec* [(- xv) (+ (Math/max 0 (- yv)) (- y))] ground-strength)
                 [0 0])) (vals nodes))))

-(defn calculate-all-node-forces [nodes springs]
+(defn calculate-all-node-forces [{:keys [nodes springs hinges]}]
     (merge-with vec+
         (calculate-spring-forces nodes springs)
+        (calculate-hinge-forces nodes hinges)
         (calculate-gravity-forces nodes)
         (calculate-ground-forces nodes)))

@@ -139,7 +182,7 @@
             (update-node-positions
                 (update-node-velocities
                     (:nodes state)
-                    (calculate-all-node-forces (:nodes state) (:springs state))
+                    (calculate-all-node-forces state)
                     tick-step)
                 tick-step)))


CMR-114: Factored in Jason's comments including fixtures.

--- test/cmr_system_int_test/concept_ingest_test.clj
+++ test/cmr_system_int_test/concept_ingest_test.clj
@@ -3,9 +3,17 @@
   (:require [clojure.test :refer :all]
             [cmr-system-int-test.ingest-util :as ingest]
             [cmr-system-int-test.index-util :as index]
-            [cmr.common.log :as log :refer (debug info warn error)]
+            [ring.util.io :as io]
             [clj-http.client :as client]
-            [cheshire.core :as cheshire]))
+            [cheshire.core :as cheshire]
+            [cmr-system-int-test.ingest-util :as util]))
+
+;;; data related
+(def base-concept-attribs
+  {:short-name "SN-Sedac88"
+   :version "Ver88"
+   :long-name "LongName Sedac88"
+   :dataset-id "LarcDatasetId88"})

 (defn concept
   "Creates a sample concept."
@@ -13,8 +21,8 @@
   {:concept-type :collection
    :native-id "nativeId1"
    :provider-id (str "PROV" provider-suffix-num)
-   :metadata "xml here"
-   :format "iso19115"})
+   :metadata (util/metadata-xml base-concept-attribs)
+   :format "iso19115+xml"})

 (defn construct-ingest-rest-url
   "Construct ingest url based on concept."
@@ -26,19 +34,17 @@
         ingest-rest-url (str "http://" host ":" port "/" ctx-part)]
     ingest-rest-url))

+;;; operation
 (defn ingest-concept
   "Make a concept create / delete request on ingest.  Returns a map with
   status, concept-id, and revision-id"
   [method concept]
-  (info method)
-  (info concept)
-  (let [coerced-json-str (cheshire/generate-string concept)
-        response (client/request
+  (let [response (client/request
                    {:method (keyword method)
                     :url (construct-ingest-rest-url concept)
-                    :body  coerced-json-str
+                    :body  (io/string-input-stream (:metadata concept))
                     :body-encoding "UTF-8"
-                    :content-type :json
+                    :content-type (:format concept)
                     :socket-timeout 2000  ;; in milliseconds
                     :conn-timeout 2000    ;; in milliseconds
                     :accept :json
@@ -47,59 +53,96 @@
         body (cheshire/parse-string (:body response))
         concept-id (get body "concept-id")
         revision-id (get body "revision-id")]
-    (info "ingest-concept fn response" response)
-    (info "test status" status)
-    (info "test concept-id " concept-id )
-    (info "test revision-id " revision-id )
     {:status status :concept-id concept-id :revision-id revision-id :response response}))

 (def provider-suffix-num-atom (atom (rand-int 1000000)))
+
+;;; fixture related
+(def ^:dynamic *save-concept-list* nil)
+(def ^:dynamic *delete-concept-list* nil)
+(def rand-start-num (atom (rand-int 1000000)))
+
+(defn distinct-concept
+  "Generate a concept-type, provicer-id, native-id tuple"
+  [token]
+  (hash-map :concept-type :collection
+            :provider-id (str "PROV" token)
+            :native-id (str "nativeId" token)
+            :metadata (util/metadata-xml base-concept-attribs)
+            :format "iso19115+xml"))
+
+(defn gen-distinct-concepts
+  "Generate requested number of distinct concepts."
+  [seed-val num-concepts]
+ (map distinct-concept (range seed-val (+ seed-val num-concepts))))
+
+(defn setup
+  "set stage for creating P (save concepts) and Q (delete concepts ) new distinct concepts in mdb and index."
+  [P Q]
+  (alter-var-root #'*save-concept-list*
+                  (constantly (gen-distinct-concepts @rand-start-num P)))
+  (alter-var-root #'*delete-concept-list*
+                  (constantly (gen-distinct-concepts (+ @rand-start-num P) Q)))
+  (swap! rand-start-num + P Q))
+
+;; teardown function behavior not correct ???
+(defn teardown
+  "tear down after the test - delete test created concepts"
+  []
+  (for [saved-concept *save-concept-list*]
+    (ingest-concept :delete saved-concept)))
+

 ;;; tests
 ;;; ensure metadata and ingest apps are accessable on ports 3001 and 3002 resp;
 ;;; add indexer app etc later to this list
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Ingest a new concept with no revision-id.
 (deftest concept-ingest-test
-  "Verrify successful ingest of concept."
-  (swap! provider-suffix-num-atom inc)
+  (let [{:keys [status revision-id]} (ingest-concept :put (first *save-concept-list*))]
+    (is (and (= status 200) (= revision-id 0)))))
+
+;; Ingest same concept N times and verify it is in metadata db with revision id value 'N - 1'.
+(deftest repeat-same-concept-ingest-test
+  (let [N 4
+        expected-revision-id (- N 1)
+        last-revision-id (last (repeatedly N
+                                           #(let [ {:keys [revision-id]} (ingest-concept :put (second *save-concept-list*))]
+                                              revision-id)))]
+    (is (= expected-revision-id last-revision-id))))
+
+;; Verify concept is deleted from mdb and index.
+(deftest save-concept-for-future-delete-test
+  (let [{:keys [status revision-id]} (ingest-concept :put (first *delete-concept-list*))]
+    (is (and (= status 200) (= revision-id 0)))))
+
+(deftest delete-concept-test
+  (let [{:keys [status]} (ingest-concept :delete (first *delete-concept-list*))]
+    (is (= status 200))))
+
+(deftest save-n-delete-test
+  (save-concept-for-future-delete-test)
+  (delete-concept-test))
+
+(defn ingest-test-fixture
+  [f]
+  (setup 2 1)
   (try
-    (let [{:keys [status revision-id]} (ingest-concept "put" (concept @provider-suffix-num-atom))]
-      (is (and (= status 200) (= revision-id 0))))
-    (catch Exception e
-      (error "Exception occurred while executing concept-ingest-test: " (.getMessage e))
-      (.printStackTrace e)
-      (is false))))
+    (f)
+    (finally (teardown))))

-(deftest repeat-same-concept-ingest-test
-  "Ingest same concept N times and verify it is in metadata db with revision id value 'N - 1'."
-  (swap! provider-suffix-num-atom inc)
-  (try
-    (let [N 4
-          expected-revision-id (- N 1)
-          last-revision-id (last (repeatedly N
-                                             #(let [ {:keys [revision-id]} (ingest-concept "put" (concept @provider-suffix-num-atom))]
-                                                revision-id)))]
-      (is (= expected-revision-id last-revision-id)))
-    (catch Exception e
-      (error "Exception occurred while executing repeat-same-concept-ingest-test: " (.getMessage e))
-      (.printStackTrace e)
-      (is false))))
+(deftest test-suite
+  (concept-ingest-test)
+  (repeat-same-concept-ingest-test)
+  (save-n-delete-test))

-;; ingest a concept first and delete the very same concept.
-(deftest delete-concept-test
-  "Verify concept is deleted from mdb and index."
-  (swap! provider-suffix-num-atom inc)
-  (try
-    (let [{:keys [status revision-id]} (ingest-concept "put" (concept @provider-suffix-num-atom))
-          saved? (and (= status 200) (= revision-id 0))]
-      (if saved?
-        (let [{:keys [status]} (ingest-concept "delete" (concept @provider-suffix-num-atom))]
-          (is (= status 200)))
-        (is false)))
-    (catch Exception e
-      (error "Exception occurred while executing concept-ingest-test: " (.getMessage e))
-      (.printStackTrace e)
-      (is false))))
+(defn test-ns-hook []
+  (ingest-test-fixture test-suite))
+
+
+(comment
+  (test-ns *ns*))


Fixed trainer tests

Fixed trainer tests

--- test/asols/trainer_test.clj
+++ test/asols/trainer_test.clj
@@ -3,7 +3,7 @@
             [clojure.test :refer :all]
             [taoensso.timbre.profiling :refer [profile p]]
             [asols.network :as net]
-            [asols.commands :refer [->TrainOpts ->MutationOpts]]
+            [asols.commands :refer [train-opts ->MutationOpts]]
             [asols.data :as data]
             [asols.trainer :refer :all]
             [asols.solver :as s]))
@@ -24,7 +24,7 @@
                 (net/insert-layer 1 :asols.trainer/sigmoid 2))
         entry {:input-vec (array [0.5 1])
                :target-vec (array [1 1])}
-        t-opts (->TrainOpts 0.1 0.5 0.1 100 1 1)
+        t-opts (train-opts )
         initial-delta-w (get-initial-delta-w net)
         results (backprop-step-delta net entry 1 t-opts initial-delta-w)
         [delta-weights delta-biases] results]
@@ -45,7 +45,7 @@
                  {:input-vec  (array [1 1])
                   :target-vec (array [1 0])}]
         untrained-cost (calc-cost net entries)
-        t-opts (->TrainOpts 0.1 0.3 0.0 100 1 1)
+        t-opts (train-opts)
         trained-net (train-epoch net entries t-opts)
         trained-cost (calc-cost trained-net entries)
         net-shapes (for [layer (:layers net)]
@@ -70,7 +70,7 @@
                  {:input-vec  (array [1 1])
                   :target-vec (array [1 0])}]
         untrained-cost (calc-cost net entries)
-        t-opts (->TrainOpts 0.1 0.5 0.1 100 1 1)
+        t-opts (train-opts)
         trained-net (train net entries t-opts)
         trained-cost (calc-cost trained-net entries)]
     (is (not= net trained-net))


Minor fixes on tests.

Minor fixes on tests.

--- test/cats/builtin_spec.cljc
+++ test/cats/builtin_spec.cljc
@@ -159,9 +159,11 @@
 (t/deftest any-monoid
   (t/testing "mempty"
     (ctx/with-context b/any-monoid
-      (t/is (= false (p/mempty (ctx/get-current))))))
+      (t/is (= false (m/mempty)))))
+
   (t/testing "mappend"
     (ctx/with-context b/any-monoid
+      (t/is (true? (m/mappend (m/mempty) true)))
       (t/is (false? (m/mappend false false)))
       (t/is (true? (m/mappend true false)))
       (t/is (true? (m/mappend false true)))
@@ -170,9 +172,11 @@
 (t/deftest all-monoid
   (t/testing "mempty"
     (ctx/with-context b/all-monoid
-      (t/is (= true (p/mempty (ctx/get-current))))))
+      (t/is (= true (m/mempty)))))
+
   (t/testing "mappend"
     (ctx/with-context b/all-monoid
+      (t/is (false? (m/mappend (m/mempty) false)))
       (t/is (false? (m/mappend false false)))
       (t/is (false? (m/mappend true false)))
       (t/is (false? (m/mappend false true)))
@@ -181,44 +185,54 @@
 (t/deftest sum-monoid
   (t/testing "mempty"
     (ctx/with-context b/sum-monoid
-      (t/is (= 0 (p/mempty (ctx/get-current))))))
+      (t/is (= 0 (m/mempty)))))
+
   (t/testing "mappend"
     (ctx/with-context b/sum-monoid
+      (t/is (= 3 (m/mappend (m/mempty) 3)))
       (t/is (= 3 (m/mappend 1 2))))))

 (t/deftest prod-monoid
   (t/testing "mempty"
     (ctx/with-context b/prod-monoid
-      (t/is (= 1 (p/mempty (ctx/get-current))))))
+      (t/is (= 1 (m/mempty)))))
+
   (t/testing "mappend"
     (ctx/with-context b/prod-monoid
+      (t/is (= 6 (m/mappend (m/mempty) 6)))
       (t/is (= 6 (m/mappend 1 2 3)))
       (t/is (= (reduce * (range 1 6)) (apply m/mappend (range 1 6)))))))

 (t/deftest string-monoid
   (t/testing "mempty"
     (ctx/with-context b/string-monoid
-      (t/is (= "" (p/mempty (ctx/get-current))))))
-  (t/testing "mappend"
+      (t/is (= "" (m/mempty)))))
+
+  (t/testing "mappend"
+    (ctx/with-context b/string-monoid
+      (t/is (= "Hello" (m/mappend (m/mempty) "Hello"))))
     (t/is (= "Hello World" (m/mappend "Hello " "World")))
     (t/is (= "abcdefghi" (m/mappend "abc" "def" "ghi")))))

 (t/deftest pair-monoid
   (t/testing "mempty"
-    (ctx/with-context b/string-monoid
-      (t/is (= (d/pair "" "") (p/mempty b/pair-monoid))))
-    (ctx/with-context b/sum-monoid
-      (t/is (= (d/pair 0 0) (p/mempty b/pair-monoid)))))
+    (ctx/with-context (b/pair-monoid b/string-monoid)
+      (t/is (= (d/pair "" "") (m/mempty))))
+
+    (ctx/with-context (b/pair-monoid b/sum-monoid)
+      (t/is (= (d/pair 0 0) (m/mempty)))))
+
   (t/testing "mappend"
     (t/is (= (d/pair "Hello buddy" "Hello mate")
              (m/mappend
               (d/pair "Hello " "Hello ")
-              (d/pair "buddy" "mate"))))
-    ;; This won't work due to explicitly set context
-    ;; (ctx/with-context b/sum-monoid
-    ;;   (t/is (= (d/pair 10 20)
-    ;;            (m/mappend
-    ;;             (d/pair 3 5)
-    ;;             (d/pair 3 5)
-    ;;             (d/pair 4 10)))))
-    ))
+              (d/pair "buddy" "mate")))))
+
+  (t/testing "mappend with other-context"
+    (ctx/with-context (b/pair-monoid b/sum-monoid)
+      (t/is (= (d/pair 10 20)
+               (m/mappend
+                (d/pair 3 5)
+                (d/pair 3 5)
+                (d/pair 4 10))))))
+  )


Add a couple of Http 1.0 & Expect: 100-continue tests.

--- test/picard/test/server.clj
+++ test/picard/test/server.clj
@@ -437,5 +437,41 @@

   (is (not-receiving-messages)))

-;; TODO: Missing tests
-;; * Handling various 100 Continue edge cases
+(defcoretest sending-100-continue-to-1-0-client
+  [ch]
+  (deftrackedapp [upstream request]
+    (try (upstream :response [100])
+         (catch Exception err
+           (enqueue ch [:error err])))
+    (upstream :response [204 {} nil])
+    (fn [_ _]))
+
+  (http-write "POST / HTTP/1.0\r\n"
+              "Content-Length: 5\r\n"
+              "Expect: 100-continue\r\n\r\n"
+              "Hello")
+
+  (is (next-msgs
+       :request [(includes-hdrs {:http-version [1 0]
+                                 "expect" "100-continue"}) "Hello"]
+       :error #(instance? Exception %)))
+
+  (is (not-receiving-messages)))
+
+(defcoretest sending-100-continue-to-1-0-client-2
+  (deftrackedapp [upstream request]
+    (upstream :response [204 {} nil])
+    (fn [_ _]))
+
+  (http-write "POST / HTTP/1.0\r\n"
+              "Transfer-encoding: chunked\r\n"
+              "Expect: 100-continue\r\n\r\n")
+
+  (is (next-msgs :request [:dont-care :chunked]))
+
+  (http-write "5\r\nHello\r\n0\r\n\r\n")
+
+  (is (next-msgs :body "Hello"
+                 :done nil))
+
+  (is (not-receiving-messages)))


Made conexp to work again on a plain console

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

--- conexp/gui.clj
+++ conexp/gui.clj
@@ -2,9 +2,8 @@
   (:import [javax.swing UIManager])
   (:use conexp.gui.base))

-(. UIManager (setLookAndFeel (. UIManager (getSystemLookAndFeelClassName))))
-
 (defn conexp-gui []
+  (. UIManager (setLookAndFeel (. UIManager (getSystemLookAndFeelClassName))))
   (let [frame (conexp-main-frame)]
     (.setVisible frame true)
-    frame))+    frame))


using (name) instead of (string/split) to get the keyword value in (map-to-obj)

--- cljs/src/util.cljs
+++ cljs/src/util.cljs
@@ -7,8 +7,7 @@
 ;; FIXME: support nested maps
 (defn map-to-obj [m]
   (let [o (js-obj)]
-    ;; FIXME: remove ugly string/split hack once the name function is fixed
-    (doall (map #(aset o (second (string/split (first %) #"'")) (second %)) m)) o))
+    (doall (map #(aset o (name (first %)) (second %)) m)) o))

 (defn set-page-title! [title]
   (set! global/document.title title))


Fix graphql test

Fix graphql test

--- test/yetibot/core/test/webapp/routes/graphql.clj
+++ test/yetibot/core/test/webapp/routes/graphql.clj
@@ -19,15 +19,18 @@
         (:errors
           (graphql
             "query stats($timezone_offset_hours: Int!) {
-             stats(timezone_offset_hours: $timezone_offset_hours) {
-             uptime
-             adapters
-             users
-             command_count_today
-             command_count
-             history_count
-             history_count_today
-             }
+              stats(timezone_offset_hours: $timezone_offset_hours) {
+                uptime
+                adapter_count
+                user_count
+                command_count_today
+                command_count
+                history_count
+                history_count_today
+                alias_count
+                observer_count
+                cron_count
+              }
              }"
             {"timezone_offset_hours" 6}
             )))))


split up session middleware into response and request

--- ring-core/src/ring/middleware/session.clj
+++ ring-core/src/ring/middleware/session.clj
@@ -1,7 +1,46 @@
 (ns ring.middleware.session
   "Session manipulation."
   (:use ring.middleware.cookies
-        [ring.middleware.session store memory]))
+        [ring.middleware.session store memory])
+  (:require [ring.middleware.cookies :as cookies]
+            [ring.middleware.session.store :as store]
+            [ring.middleware.session.memory :as mem]))
+
+(defn session-options
+  [options]
+  {:store (options :store (mem/memory-store))
+   :cookie-name (options :cookie-name "ring-session")
+   :cookie-attrs (merge {:path "/"}
+                        (options :cookie-attrs)
+                        (if-let [root (options :root)]
+                          {:path root}))})
+
+(defn session-request-fn
+  [{:keys [store cookie-name]}]
+  (fn [request]
+    (let [req-key  (get-in request [:cookies cookie-name :value])
+          session  (store/read-session store req-key)
+          session-key (if session req-key)]
+      (merge request {:session (or session {})
+                      :session/key session-key}))))
+
+(defn session-response-fn
+  [{:keys [store cookie-name cookie-attrs]}]
+  (fn [{session-key :session/key :as response}]
+    (when (seq (dissoc response :session/key))
+      (let [new-session-key (when (contains? response :session)
+                              (if-let [session (response :session)]
+                                (store/write-session store session-key session)
+                                (when session-key
+                                  (store/delete-session store session-key))))
+            response (dissoc response :session)
+            cookie   {cookie-name
+                      (merge cookie-attrs
+                             (response :session-cookie-attrs)
+                             {:value new-session-key})}]
+        (if (and new-session-key (not= session-key new-session-key))
+          (assoc response :cookies (merge (response :cookies) cookie))
+          response)))))

 (defn wrap-session
   "Reads in the current HTTP session map, and adds it to the :session key on
@@ -26,31 +65,16 @@
       A map of attributes to associate with the session cookie. Defaults
       to {}."
   ([handler]
-    (wrap-session handler {}))
+     (wrap-session handler {}))
   ([handler options]
-     (let [store        (options :store (memory-store))
-           cookie-name  (options :cookie-name "ring-session")
-           cookie-attrs (merge {:path "/"}
-                               (options :cookie-attrs)
-                               (if-let [root (options :root)]
-                                 {:path root}))]
-      (wrap-cookies
+     (let [options (session-options options)
+           session-request (session-request-fn options)
+           session-response (session-response-fn options)]
+       (cookies/wrap-cookies
         (fn [request]
-          (let [req-key  (get-in request [:cookies cookie-name :value])
-                session  (read-session store req-key)
-                sess-key (if session req-key)
-                request  (assoc request :session (or session {}))]
-            (if-let [response (handler request)]
-              (let [sess-key* (if (contains? response :session)
-                                (if-let [session (response :session)]
-                                  (write-session store sess-key session)
-                                  (if sess-key
-                                    (delete-session store sess-key))))
-                    response (dissoc response :session)
-                    cookie   {cookie-name
-                              (merge cookie-attrs
-                                     (response :session-cookie-attrs)
-                                     {:value sess-key*})}]
-                (if (and sess-key* (not= sess-key sess-key*))
-                  (assoc response :cookies (merge (response :cookies) cookie))
-                  response)))))))))
+          (let [new-request (session-request request)
+                session-key (:session/key new-request)]
+            (-> new-request
+                handler
+                (assoc :session/key session-key)
+                session-response)))))))