snapshot: rewrote methods to use call-service. Commented out use of synchronized for now

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -74,6 +74,13 @@
   ([hostname port proxies]
      (add-proxies {:hostname hostname :port port} proxies)))

+(defn attach-session
+  ""
+  [robot]
+  (let [app (make-application)
+        session (make-session (:hostname robot) (:port robot))]
+    ))
+
 (defn make-application
   "Creates an instance of an application object"
   []
@@ -84,10 +91,16 @@
 (defn make-session
   "Create a session connected to a robot"
   [hostname port]
-  (let [session (com.aldebaran.qimessaging.Session.)
-        fut (.connect session (str "tcp://" hostname ":" port))]
-        (.wait fut 1000)
+  (let [session (com.aldebaran.qimessaging.Session.)]
         session))
+
+;; (defn make-session
+;;   "Create a session connected to a robot"
+;;   [hostname port]
+;;   (let [session (com.aldebaran.qimessaging.Session.)
+;;         fut (.connect session (str "tcp://" hostname ":" port))]
+;;         (.wait fut 1000)
+;;         session))

 (defn get-proxy
   "Gets a proxy from a robot, constructing it if necessary"
@@ -109,73 +122,70 @@
 (defn get-installed-behaviours
   "Return list of behaviours installed on robot"
   [robot]
-  (.getInstalledBehaviors (get-proxy robot :behaviour-manager)))
+  (call-service robot :behaviour-manager "getInstalledBehaviors" ))

 (defn get-running-behaviours
   "Get list of running behaviours"
   [robot]
-  (.getRunningBehaviors (get-proxy robot :behaviour-manager)))
+  (call-service robot :behaviour-manager "getRunningBehaviors"))

 (defn get-default-behaviours
   "Get list of default behaviours (behaviours set to run automatically)"
   [robot]
-  (.getDefaultBehaviors (get-proxy robot :behaviour-manager)))
+  (call-service robot :behaviour-manager "getDefaultBehaviors" ))

 (defn add-default-behaviour
   "Make the named behaviour auto run on robot boot"
   [robot behaviour-name]
-  (.addDefaultBehavior (get-proxy robot :behaviour-manager) behaviour-name))
+  (call-service robot :behaviour-manager "addDefaultBehavior" [behaviour-name]))

 (defn remove-default-behaviour
   "Stop the named behaviour auto running on robot boot"
   [robot behaviour-name]
-  (.removeDefaultBehavior (get-proxy robot :behaviour-manager) behaviour-name))
+  (call-service robot :behaviour-manager "removeDefaultBehavior" [behaviour-name]))

 (defn run-behaviour
   "Run the named behaviour"
   [robot behaviour-name]
-  (.runBehavior (get-proxy robot :behaviour-manager) behaviour-name))
+  (call-service robot :behaviour-manager "runBehavior" [behaviour-name]))

 (defn behaviour-present
   "Is the named behaviour present?"
   [robot behaviour-name]
-  (.isBehaviorPresent (get-proxy robot :behaviour-manager) behaviour-name))
+  (call-service robot :behaviour-manager "isBehaviorPresent" [behaviour-name]))

 (defn behaviour-running
   "Is the named behaviour running"
   [robot behaviour-name]
-  (.isBehaviorRunning (get-proxy robot :behaviour-manager) behaviour-name))
+  (call-service robot :behaviour-manager "isBehaviorRunning"  [behaviour-name]))

 ; memory
 (defn get-memory-keys
   "List memory keys"
   [robot]
-  (.getDataListName (get-proxy robot :memory)))
+  (call-service robot :memory "getDataListName"))

 (defn get-memory-keys-containing
   "List memory keys containing string value"
   [robot val]
-  (.getDataList (get-proxy robot :memory) val))
-
-;; TODO need a way to unpack the Variant
-;; currently get the following error when trying to extract values from the result
-;; ClassNotFoundException com.aldebaran.proxy.Variant$typeV  java.net.URLClassLoader$1.run (URLClassLoader.java:366)
-;; (defn get-memory-value
-;;   "Get named value from memory"
-;;   [robot key]
-;;   (.getData (get-proxy robot :memory) key))
-
-;; (defn get-memory-values
-;;   "Get values for list of named keys"
-;;   [robot keys]
-;;   (.getData (get-proxy robot :memory)
-;;             (make-variant (to-array keys))))
+  (call-service robot :memory"getDataList"  [val]))
+
+(defn get-memory-value
+   "Get named value from memory"
+   [robot key]
+   (call-service robot :memory "getData" [key]))
+
+(defn get-memory-values
+   "Get values for list of named keys"
+   [robot keys]
+   (call-service robot :memory "getData"
+             [(to-array keys)]))

 ; posture
 (defn go-to-posture
   "Move to the specified posture (use symbol). relative-speed is between zero and one"
   [robot posture relative-speed]
-  (.goToPosture (get-proxy robot :posture) (postures posture) relative-speed))
+  (call-service robot :posture "goToPosture" [(postures posture) relative-speed]))

 (defn crouch
   "Crouch"
@@ -237,87 +247,87 @@
 (defn wake-up
   "The robot wakes up: sets Motor on and, if needed, goes to initial position. For example, H25 or H21 sets the Stiffness on and keeps is current position."
   [robot]
-  (.wakeUp (get-proxy robot :motion)))
+  (call-service robot :motion "wakeUp"))

 (defn relax
   "The robot rests: goes to a relax and safe position and sets Motor off. For example, H25 or H21 goes to the Crouch posture and sets the Stiffness off."
   [robot]
-  (.rest (get-proxy robot :motion)))
+  (call-service robot :motion "rest"))

 (defn walk
   "Walk at the specified speed. x, y, & theta represent normalised velocities from 0.0 to 1.0"
   [robot x y theta]
-  (.moveToward (get-proxy robot :motion) x y theta))
+  (call-service robot :motion "moveToward" [x y theta]))

 (defn walk-to
   "Walk to a specified location in the robot's frame of reference"
   [robot x y theta]
-  (.moveTo (get-proxy robot :motion) x y theta))
+  (call-service robot :motion "moveTo" [x y theta]))

 (defn get-joint-angles
   "Return a map of the current joint angles for a robot"
   [robot]
   (zipmap joint-names
-          (.getAngles (get-proxy robot :motion)
-                      (make-variant "Body") true)))
+          (call-service robot :motion "getAngles"
+                      ["Body" true])))
 (defn get-body-names
   "Return names of joints in the specified chain"
   [robot name]
-  (.getBodyNames (get-proxy robot :motion) name))
+  (call-service robot :motion "getBodyNames"  [name]))

 ;; broken - can't construct variant holding array of values
 (defn set-joint-angles
   "Set the named joints to absolute changes"
   [robot names angles speed]
-  (.setAngles (get-proxy robot :motion)
-              (to-array names)
-              (to-array angles) speed))
+  (call-service robot :motion "setAngles"
+              [(to-array names)
+              (to-array angles) speed]))

 ;; broken - can't construct variant holding array of values
 (defn change-joint-angles
   "Relative changes to joint angles"
   [robot names changes speed]
-    (.changeAngles (get-proxy robot :motion)
-                   (to-array names)
-                   (to-array changes) speed))
+    (call-service robot :motion "changeAngles"
+                   [(to-array names)
+                   (to-array changes) speed]))

 (defn get-robot-position
   "Get the current position of the robot using the sensors if true"
   [robot use-sensors]
-  (.getRobotPosition (get-proxy robot :motion) use-sensors))
+  (call-service robot :motion "getRobotPosition"  [use-sensors]))

 (defn get-position
   "Get the current 6D position (x, y, z, wx, wy, wz) of named component, using the sensors if use-sensors is true"
   [robot name space use-sensors]
-  (.getPosition (get-proxy robot :motion) name space use-sensors))
+  (call-service robot :motion "getPosition" [name space use-sensors]))

 (defn get-sensor-names
   "Get the names of the available sensors"
   [robot]
-  (.getSensorNames (get-proxy robot :motion)))
+  (call-service robot :motion "getSensorNames"))

 ; text to speech
 (defn say
   "Say something"
   [robot text]
-  (.call (get-proxy robot :tts) "say" (into-array [text])))
+  (call-service robot :tts "say" [text]))

 (defn get-language
   "Get the currently defined text-to-speech language"
   [robot]
-  (.getLanguage (get-proxy robot :tts)))
+  (call-service robot :tts "getLanguage"))

 (defn set-language
   "Set the language the robot should use"
   [robot language]
-  (.setLanguage (get-proxy robot :tts) language))
+  (call-service robot :tts "setLanguage" [language]))

 (defn get-volume
   "Get the current volume for the robot"
   [robot]
-  (.getVolume (get-proxy robot :tts)))
+  (call-service robot :tts "getVolume"))

 (defn set-volume
   "Set the volume used by the robot"
   [robot vol]
-  (.setVolume (get-proxy robot :tts) (float vol)))
+  (call-service robot :tts "setVolume" [(float vol)]))


Prefer i.c.Dataset to j.u.Map when parsing params

--- src/pipeline/grafter/pipeline/types.clj
+++ src/pipeline/grafter/pipeline/types.clj
@@ -153,6 +153,7 @@
 (swap! parameter-types derive ::tabular-dataset ::text-file)

 (prefer-method parse-parameter [String ::tabular-dataset] [String Map])
+(prefer-method parse-parameter [Map ::tabular-dataset] [Map Map])

 (swap! parameter-types derive java.io.InputStream ::binary-file)


added more data massaging for tests

added more data massaging for tests

--- test/asset_minifier/core_test.clj
+++ test/asset_minifier/core_test.clj
@@ -12,13 +12,15 @@
       (.delete file))
     (.delete file)))

-(defn round-gzipped [m]
-  (update-in m [:gzipped-size] #(when % (int (/ % 100)))))
+(defn massage-data [m]
+  (-> m
+   (update-in [:sources] set)
+   (update-in [:gzipped-size] #(when % (int (/ % 100))))))

 (defmacro run-test [fn result]
   `(do
      (clean-output (file output-path))
-     (is (= (round-gzipped ~result) (round-gzipped ~fn)))))
+     (is (= (massage-data ~result) (massage-data ~fn)))))

 (deftest test-minification


Fix call order for scalarmult

Fix call order for scalarmult

--- src/caesium/crypto/scalarmult.clj
+++ src/caesium/crypto/scalarmult.clj
@@ -14,18 +14,18 @@
   "Performs scalar multiplication into the given out buffer against a
   given point using `crypto_scalarmult`, or against the fixed base
   point with `crypto_scalarmult_base` when no point is passed."
-  ([n q]
+  ([q n]
    (b/✨ scalarmult-base q n))
-  ([n p q]
+  ([q n p]
    (b/✨ scalarmult q n p)))

 (defn scalarmult
   "Performs scalar multiplication against a given point, using"
   ([n]
    (let [q (byte-array bytes)]
-     (scalarmult-to-buf! n q)
+     (scalarmult-to-buf! q n)
      q))
   ([n p]
    (let [q (byte-array bytes)]
-     (scalarmult-to-buf! n p q)
+     (scalarmult-to-buf! q n p)
      q)))


New test for function generator-script

New test for function generator-script

--- test/clj_flotr/generator_test.clj
+++ test/clj_flotr/generator_test.clj
@@ -83,3 +83,14 @@
             "true" (bool->string {})
             "true" (bool->string #{}))))

+(deftest test-script
+    (testing "Test the function script"
+        (are [x y] (= x y)
+            [:script {:type "text/javascript" :src ""}]       (script nil nil)
+            [:script {:type "text/javascript" :src ""}]       (script "" "")
+            [:script {:type "text/javascript" :src "aaa"}]    (script "aaa" "")
+            [:script {:type "text/javascript" :src "bbb"}]    (script "" "bbb")
+            [:script {:type "text/javascript" :src "aaa"}]    (script "aaa" nil)
+            [:script {:type "text/javascript" :src "bbb"}]    (script nil "bbb")
+            [:script {:type "text/javascript" :src "aaabbb"}] (script "aaa" "bbb"))))
+


run the basic test for each command line flag

--- src/chestnut/test/integration.clj
+++ src/chestnut/test/integration.clj
@@ -2,7 +2,8 @@
   (:require [clojure.java.io :as io]
             [mistletoe.process :refer :all]
             [mistletoe.test :refer :all]
-            [clj-webdriver.taxi :as browser]))
+            [clj-webdriver.taxi :as browser]
+            [leiningen.new.chestnut :as chestnut]))

 (def browser-type :chrome)

@@ -53,21 +54,22 @@
      (finally
        (browser/close))))

-(defn generate-new-app []
-  (println "--> Generating app in /tmp/sesame-seed")
+(defn generate-new-app [& [flags]]
+  (println "--> Generating app in /tmp/sesame-seed using" flags)
   (rm-rf "/tmp/sesame-seed")
-  (wait-for (spawn "LEIN NEW" "/tmp" "lein new chestnut sesame-seed --snapshot")))
+  (wait-for (spawn "LEIN NEW" "/tmp"
+                   (str "lein new chestnut sesame-seed --snapshot -- " flags))))

 (defn first-element-text [selector]
   (browser/text (first (browser/css-finder selector))))

-(defn test-basic []
-  (generate-new-app)
+(defn test-basic [& [flags]]
+  (generate-new-app flags)
   (println "--> Starting REPL")
   (with-process [repl "REPL" "/tmp/sesame-seed" "lein repl"]
-    (expect repl #"sesame-seed\.server=>" 90)
+    (expect repl #"sesame-seed\.server=>" 120)
     (write-str repl "(run)\n")
-    (expect repl #"notifying browser that file changed")
+    (expect repl #"notifying browser that file changed" 90)
     (write-str repl "(browser-repl)\n")
     (expect repl #"sesame-seed\.core=>")

@@ -77,4 +79,6 @@
       (browser/wait-until #(= (first-element-text "h1") "Hello Test :)")))))

 (defn -main []
-  (test-basic))
+  (test-basic)
+  (doseq [opt chestnut/valid-options]
+    (test-basic opt)))


implement run-system & demo movement-system

--- src/clj/resonate2015/day1/ecs.clj
+++ src/clj/resonate2015/day1/ecs.clj
@@ -1,11 +1,22 @@
-(ns resonate2015.day1.ecs)
+(ns resonate2015.day1.ecs
+  (:require
+    [clojure.set :as set]
+    [thi.ng.geom.core :as g]
+     [thi.ng.geom.core.vector :as v]
+     [thi.ng.geom.aabb :as a]
+     [thi.ng.geom.circle :as c]
+     [thi.ng.geom.types.utils.ptf :as ptf]
+     [thi.ng.common.math.core :as m :refer [THIRD_PI TWO_PI]]))
+
+(require '[thi.ng.geom.mesh.io :as mio])
+(require '[clojure.java.io :as io])

 ;; (component :position {:x 0 :y 10})

 ;; 1 [pos col vel renderable] ;; player
 ;; 2 [skill pos vel]

-;; 1 {:pos {:x 1 :y 0} :color :red :renderable true}
+;; 1 {:pos [0 0] :vel [1 -1] :color :red :renderable true}
 ;; 2 {:pos {:x ...} :vel {....}

 ;; color
@@ -17,9 +28,10 @@

 (defn make-app
   []
-  (atom {:uuid-counter 0
-         :entities     {}
-         :systems      {}}))
+  (atom
+    {:uuid-counter 0
+     :entities     {}
+     :systems      {}}))

 (defn new-entity!
   "Defines a new entity ID"
@@ -72,26 +84,15 @@
   [app-state name]
   (let [{:keys [entities systems]} (deref app-state)
         {sys-fn :fn comp-ids :comp-ids} (systems name)
-        valid-entity? (make-entity-validator comp-ids)
+        valid-entity?     (make-entity-validator comp-ids)
         matching-entities (filter valid-entity? entities)]
      (dorun
        (map
          (fn [[eid estate]] (sys-fn app-state eid estate))
          matching-entities))))

-
-(let (a "hello" b "whatever")
-
-(defn foo [{c :a d :b}]
-  )
-
-(run-system app-state :render)
-
-(def a 23)
-
-
-
-(let [a 42
-       (+ a 10)
-      a :foo]
-  b)+(defn movement-system
+  [app-state eid estate]
+  (let [{:keys [pos vel]} estate
+        pos' (mapv + pos vel)]
+    (swap! app-state assoc-in [:entities eid :pos] pos')))


Pluralization fixes for player stats view

A few pieces of text were actually modified.  Mostly the cases under
which plural text is seen have been modified to include values less than
1.

Notable changes to text:

- **Brain Damage**; I don't think it makes sense to pluralize this
  quantity.  It is more natural to say "I have 5 Brain Damage." This
  is similar to the card Scorched Earth that says, "Deal 4 Meat Damage."

- **Bad Publicity**; Pluralizing this sounds wrong.  Similar to Brain
  Damage saying, "Take 2 Bad Publicity," sounds more within correct
  reason.

- **Link** also didn't make sense to pluralize.  But I believe that
  **Link Strength** is the canonical term.  So that is used instead to
  make it sounds more natural.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -605,17 +605,17 @@
     (let [me? (= (:side @game-state) :runner)]
       [:div.stats.panel.blue-shade {}
        [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
-       [:div (str click " Click" (if (> click 1) "s" "")) (when me? (controls :click))]
-       [:div (str credit " Credit" (if (> credit 1) "s" "")
+       [:div (str click " Click" (if (not= click 1) "s" "")) (when me? (controls :click))]
+       [:div (str credit " Credit" (if (not= credit 1) "s" "")
                   (when (pos? run-credit)
                     (str " (" run-credit " for run)")))
         (when me? (controls :credit))]
-       [:div (str memory " Memory Unit" (if (not= memory 0) "s" "")) (when (neg? memory) [:div.warning "!"]) (when me? (controls :memory))]
-       [:div (str link " Link" (if (> link 1) "s" "")) (when me? (controls :link))]
-       [:div (str agenda-point " Agenda Point" (when (> agenda-point 1) "s"))
+       [:div (str memory " Memory Unit" (if (not= memory 1) "s" "")) (when (neg? memory) [:div.warning "!"]) (when me? (controls :memory))]
+       [:div (str link " Link Strength") (when me? (controls :link))]
+       [:div (str agenda-point " Agenda Point" (when (not= agenda-point 1) "s"))
         (when me? (controls :agenda-point))]
-       [:div (str tag " Tag" (if (> tag 1) "s" "")) (when (or (pos? tag) (pos? tagged)) [:div.warning "!"]) (when me? (controls :tag))]
-       [:div (str brain-damage " Brain Damage" (if (> brain-damage 1) "s" ""))
+       [:div (str tag " Tag" (if (not= tag 1) "s" "")) (when (or (pos? tag) (pos? tagged)) [:div.warning "!"]) (when me? (controls :tag))]
+       [:div (str brain-damage " Brain Damage")
         (when me? (controls :brain-damage))]
        [:div (str (+ hand-size-base hand-size-modification) " Max hand size")
         (when me? (controls :hand-size-modification))]]))))
@@ -627,11 +627,11 @@
     (let [me? (= (:side @game-state) :corp)]
       [:div.stats.panel.blue-shade {}
        [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
-       [:div (str click " Click" (if (> click 1) "s" "")) (when me? (controls :click))]
-       [:div (str credit " Credit" (if (> credit 1) "s" "")) (when me? (controls :credit))]
-       [:div (str agenda-point " Agenda Point" (when (> agenda-point 1) "s"))
+       [:div (str click " Click" (if (not= click 1) "s" "")) (when me? (controls :click))]
+       [:div (str credit " Credit" (if (not= credit 1) "s" "")) (when me? (controls :credit))]
+       [:div (str agenda-point " Agenda Point" (when (not= agenda-point 1) "s"))
         (when me? (controls :agenda-point))]
-       [:div (str bad-publicity " Bad Publicit" (if (> bad-publicity 1) "ies" "y"))
+       [:div (str bad-publicity " Bad Publicity")
         (when me? (controls :bad-publicity))]
        [:div (str (+ hand-size-base hand-size-modification) " Max hand size")
         (when me? (controls :hand-size-modification))]]))))


safeguard against nil instances

safeguard against nil instances

--- src/cljs/salava/user/ui/data.cljs
+++ src/cljs/salava/user/ui/data.cljs
@@ -97,10 +97,14 @@
                                  :else (t value))]]))]]])

             (when-not (blank? language) [:div.col-xs-12 [:b (t :user/Language)": "] (upper-case language)])
-            [:div.col-xs-12 [:b (t :user/Country)": "] country]
-            [:div.col-xs-12 [:b (str (t :user/Emailnotifications) ": ")]  (if (true? email_notifications) (t :core/Yes) (t :core/No)) #_(str email_notifications)]
-            [:div.col-xs-12 [:b (str (t :user/Privateprofile) ": ")] (if (true? private) (t :core/Yes) (t :core/No))]
-            [:div.col-xs-12 [:b (str (t :user/Activated) ": ")] (if (true? activated?) (t :core/Yes) (t :core/No))]
+            (when-not (blank? country)
+              [:div.col-xs-12 [:b (t :user/Country)": "] country])
+            (when-not (blank? (str email_notifications))
+              [:div.col-xs-12 [:b (str (t :user/Emailnotifications) ": ")]  (if (true? email_notifications) (t :core/Yes) (t :core/No))])
+            (when-not (blank? (str private))
+              [:div.col-xs-12 [:b (str (t :user/Privateprofile) ": ")] (if (true? private) (t :core/Yes) (t :core/No))])
+            (when-not (blank? (str activated?))
+              [:div.col-xs-12 [:b (str (t :user/Activated) ": ")] (if (true? activated?) (t :core/Yes) (t :core/No))])
             (when-not (blank? profile_visibility)
               [:div.col-xs-12 {:style {:margin-bottom "20px"}} [:b (str (t :user/Profilevisibility) ": ")] (t (keyword (str "core/"(capitalize profile_visibility))))])]]]

@@ -139,8 +143,8 @@
              (doall
                (for [p pending_badges]
                  ^{:key p}[:div
-                           [:div.col-xs-12 [:b (str (t :badge/Name) ": ")] (:name p)]
-                           [:div.col-xs-12 [:b (str (t :page/Description) ": ")] (:description p)]
+                           [:div.col-xs-12 [:b (str (t :badge/Name) ": ")] (or (:name p) "-")]
+                           [:div.col-xs-12 [:b (str (t :page/Description) ": ")] (or (:description p) "-")]
                            ]))])]

          [:div {:class "col-md-12 col-sm-9 col-xs-12"}


Use blocks instead of list items for catalog items

There is no visual advantage to using list items and the blocks make it
easy to add the proper structure for screen readers

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -98,10 +98,8 @@
       [:fo:inline default args])))

 (defn- list-item [& args]
-  [:fo:list-item {:space-after "1em"}
-   [:fo:list-item-label [:fo:block]]
-   [:fo:list-item-body
-    args]])
+  [:fo:block {:space-after "1em" :role "LI"}
+   args])

 (defn- bold [& args]
   (inline {:font-weight "bold"} args))
@@ -207,7 +205,7 @@
 (defmulti entry-heading-sexp (fn [{fmt :format}] fmt))
 (defmethod entry-heading-sexp :ludo
   [{:keys [creator record-id title subtitles]}]
-  (block {:keep-with-next "always"}
+  (block {:keep-with-next.within-column "always" :role "Lbl"}
          (bold (link-to-online-catalog record-id (layout/periodify title)))
          (when subtitles " ")
          (layout/render-subtitles subtitles)
@@ -215,7 +213,7 @@

 (defmethod entry-heading-sexp :default
   [{:keys [creator record-id title subtitles name-of-part source-publisher source-date]}]
-  (block {:keep-with-next "always"}
+  (block {:keep-with-next.within-column "always" :role "Lbl"}
          (bold (wrap creator "" ": " false)
                (link-to-online-catalog record-id (layout/periodify title)))
          (when subtitles " ")
@@ -239,6 +237,9 @@
     (block {:keep-with-previous.within-column "always"}
            (bold "Verkauf:") " " price ". " (layout/braille-signatures product-number))))

+(defn- list-body [& args]
+  (block {:role "LBody"} args))
+
 (defmulti entry-sexp (fn [{fmt :format} opts] fmt))

 (defmethod entry-sexp :hörbuch
@@ -247,14 +248,15 @@
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (when show-genre?
-     (block (wrap genre-text "Genre: ")))
-   (block (wrap description))
-   (block (wrap duration "" " Min., " false) (narrators-sexp narrators))
-   (block producer-brief (if produced-commercially? ", Hörbuch aus dem Handel" "") ".")
-   (ausleihe library-signature)
-   (when product-number
-     (block {:keep-with-previous "always"} (bold "Verkauf:") " " product-number ", " price))))
+   (list-body
+    (when show-genre?
+      (block (wrap genre-text "Genre: ")))
+    (block (wrap description))
+    (block (wrap duration "" " Min., " false) (narrators-sexp narrators))
+    (block producer-brief (if produced-commercially? ", Hörbuch aus dem Handel" "") ".")
+    (ausleihe library-signature)
+    (when product-number
+      (block {:keep-with-previous "always"} (bold "Verkauf:") " " product-number ", " price)))))

 (defmethod entry-sexp :braille
   [{:keys [genre-text description producer-brief rucksackbuch? rucksackbuch-number
@@ -262,38 +264,41 @@
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (when show-genre?
-     (block (wrap genre-text "Genre: ")))
-   (block (wrap description))
-   (block (wrap producer-brief "" (if rucksackbuch?
-                                    (str ", Rucksackbuch Nr. " rucksackbuch-number)
-                                    "")))
-   (ausleihe-multi library-signature)
-   (verkauf product-number price)))
+   (list-body
+    (when show-genre?
+      (block (wrap genre-text "Genre: ")))
+    (block (wrap description))
+    (block (wrap producer-brief "" (if rucksackbuch?
+                                     (str ", Rucksackbuch Nr. " rucksackbuch-number)
+                                     "")))
+    (ausleihe-multi library-signature)
+    (verkauf product-number price))))

 (defmethod entry-sexp :grossdruck
   [{:keys [genre-text description library-signature volumes product-number price] :as item}
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (when show-genre?
-     (block (wrap genre-text "Genre: ")))
-   (block (wrap description))
-   (when library-signature
-     (block {:keep-with-previous "always"}
-            (bold "Ausleihe:") " " library-signature (wrap volumes ", " " Bd. " false)))
-   (when product-number
-     (block {:keep-with-previous "always"} (bold "Verkauf:") " " price))))
+   (list-body
+    (when show-genre?
+      (block (wrap genre-text "Genre: ")))
+    (block (wrap description))
+    (when library-signature
+      (block {:keep-with-previous "always"}
+             (bold "Ausleihe:") " " library-signature (wrap volumes ", " " Bd. " false)))
+    (when product-number
+      (block {:keep-with-previous "always"} (bold "Verkauf:") " " price)))))

 (defmethod entry-sexp :e-book
   [{:keys [genre-text description library-signature] :as item}
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (when show-genre?
-     (block (wrap genre-text "Genre: ")))
-   (block (wrap description))
-   (ausleihe library-signature)))
+   (list-body
+    (when show-genre?
+      (block (wrap genre-text "Genre: ")))
+    (block (wrap description))
+    (ausleihe library-signature))))

 (defmethod entry-sexp :hörfilm
   [{:keys [personel-text movie_country genre-text
@@ -301,13 +306,14 @@
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap personel-text))
-   (block (wrap movie_country))
-   (when show-genre?
-     (block (wrap genre-text)))
-   (block (wrap description))
-   (block (wrap producer))
-   (ausleihe library-signature)))
+   (list-body
+    (block (wrap personel-text))
+    (block (wrap movie_country))
+    (when show-genre?
+      (block (wrap genre-text)))
+    (block (wrap description))
+    (block (wrap producer))
+    (ausleihe library-signature))))

 (defmethod entry-sexp :ludo
   [{:keys [source-publisher genre-text description
@@ -315,36 +321,39 @@
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap source-publisher))
-   (when show-genre?
-     (block (wrap genre-text)))
-   (block (wrap description))
-   (block (wrap game-description))
-   (ausleihe library-signature)))
+   (list-body
+    (block (wrap source-publisher))
+    (when show-genre?
+      (block (wrap genre-text)))
+    (block (wrap description))
+    (block (wrap game-description))
+    (ausleihe library-signature))))

 (defmethod entry-sexp :musiknoten
   [{:keys [description producer-brief library-signature product-number price] :as item} opts]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap description))
-   (block (wrap producer-brief))
-   (ausleihe-multi library-signature)
-   (verkauf product-number price)))
+   (list-body
+    (block (wrap description))
+    (block (wrap producer-brief))
+    (ausleihe-multi library-signature)
+    (verkauf product-number price))))

 (defmethod entry-sexp :taktilesbuch
   [{:keys [genre-text description producer-brief library-signature product-number price] :as item}
    {:keys [show-genre?] :or {show-genre? true}}]
   (list-item
    (entry-heading-sexp item)
-   (when show-genre?
-     (block (wrap genre-text "Genre: ")))
-   (block (wrap description))
-   (block (wrap producer-brief))
-   (ausleihe-multi library-signature)
-   (verkauf product-number price)))
+   (list-body
+    (when show-genre?
+      (block (wrap genre-text "Genre: ")))
+    (block (wrap description))
+    (block (wrap producer-brief))
+    (ausleihe-multi library-signature)
+    (verkauf product-number price))))

 (defn entries-sexp [items opts]
-  [:fo:list-block
+  [:fo:block {:role "L"}
    (map #(entry-sexp % opts) items)])

 (defn- level-to-h [level]


Comment on sample tracker map in c.t.n.track

--- src/main/clojure/clojure/tools/namespace/track.cljc
+++ src/main/clojure/clojure/tools/namespace/track.cljc
@@ -114,7 +114,8 @@
   {})

 (comment
-  ;; Structure of the namespace tracker map
+  ;; Structure of the namespace tracker map. Documented for reference
+  ;; only: This is not a public API.

   {;; Dependency graph of namespace names (symbols) as defined in
    ;; clojure.tools.namespace.dependency/graph


Require ssh, because we use it

Require ssh, because we use it

--- src/circle/backend/ec2.clj
+++ src/circle/backend/ec2.clj
@@ -5,6 +5,7 @@
         [circle.utils.args :only (require-args)])
   (:use [clojure.tools.logging :only (infof)])
   (:use [clojure.core.incubator :only (-?>)])
+  (:require [circle.backend.ssh])
   (:import com.amazonaws.services.ec2.AmazonEC2Client
            com.amazonaws.AmazonServiceException
            (com.amazonaws.services.ec2.model DeleteKeyPairRequest


whitespace

whitespace

--- src/clj/fleetdb/server.clj
+++ src/clj/fleetdb/server.clj
@@ -29,7 +29,7 @@
               (recur))))))))

 (def fleetdb-version
-  (let [stream  (.getResourceAsStream (RT/baseLoader) "project.clj")]
+  (let [stream (.getResourceAsStream (RT/baseLoader) "project.clj")]
     (nth (read-string (slurp* stream)) 2)))

 (defn- info-map [dba]


change Builder and Clairvoyant Monitor advancements to :placed true

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -69,7 +69,7 @@
                 {:label "Place 1 advancement token on an ICE that can be advanced on this server"
                  :msg (msg "place 1 advancement token on " (if (:rezzed target) (:title target) "a card"))
                  :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
-                 :effect (effect (add-prop target :advance-counter 1))}]}
+                 :effect (effect (add-prop target :advance-counter 1 {:placed true}))}]}

    "Bullfrog"
    {:abilities [{:msg "start a Psi game"
@@ -123,7 +123,7 @@
                                    :msg (msg "place 1 advancement token on "
                                              (if (:rezzed target) (:title target) "a card") " and end the run")
                                    :choices {:req #(= (first (:zone %)) :servers)}
-                                   :effect (effect (add-prop target :advance-counter 1) (end-run))}}}]}
+                                   :effect (effect (add-prop target :advance-counter 1 {:placed true}) (end-run))}}}]}

    "Chum"
    {:abilities [{:msg "do 3 net damage" :effect (effect (damage :net 3 {:card card}))}]}


Add docstrings for set-color-mode, enumerate

--- src/clj/genartlib/util.clj
+++ src/clj/genartlib/util.clj
@@ -42,10 +42,24 @@
     (and (>= value (min end1 end2))
          (<= value (max end1 end2))))

-  (defn set-color-mode []
+  (defn set-color-mode
+    "Set the color space to HSB, with the following ranges:
+     - Hue: [0, 360)
+     - Saturation: [0 100]
+     - Brightness: [0 100]
+     - Alpha: [0.0, 1.0]"
+    []
     (color-mode :hsb 360 100 100 1.0))

-  (defn enumerate [s]
+  (defn enumerate
+    "Returns a seq of tuples like [i v], where i enumerates
+     the position (starting from zero, of course) in the original
+     sequence and v is the corresponding value in the original
+     sequence. Example:
+
+      user=> (enumerate [:a :b :c])
+      ([0 :a] [1 :b] [2 :c])"
+    [s]
     (map-indexed vector s))

   (defn zip [seq1 seq2]


Add ^:const meta flag

Add ^:const meta flag

--- src/cljam/fasta/reader.clj
+++ src/cljam/fasta/reader.clj
@@ -121,8 +121,8 @@
          (.clear ~buffer)
          ba#)))

-(def ^:private gt-byte (byte \>))
-(def ^:private newline-byte (byte \newline))
+(def ^:private ^:const gt-byte (byte \>))
+(def ^:private ^:const newline-byte (byte \newline))

 (defn- sequqntial-read*
   "Core function to read FASTA sequentially.


Use some more authentic test data

Use some more authentic test data

--- src/cljs/cglossa/core.cljs
+++ src/cljs/cglossa/core.cljs
@@ -3,12 +3,14 @@
             [plumbing.core :as plumbing :refer [map-vals]]
             [cglossa.centre :as centre]))

-(def state {:showing-results false})
 ; avoid "not resolved" messages in Cursive
 (declare getElementById)

-(def data {:categories ["ku" "hest"]
-           :users      ["per" "kari"]})
+(def state {:showing-results? false
+            :showing-sidebar? false})
+
+(def data {:corpus {:name "LBK"
+                    :search-engine :cwb-speech}})

 (defonce app-state (into {} (map-vals atom state)))
 (defonce app-data (into {} (map-vals atom data)))


WIP: Saving editing changes into db

WIP: Saving editing changes into db

--- src/cljs/repodoc/core.cljs
+++ src/cljs/repodoc/core.cljs
@@ -35,10 +35,19 @@
   (get-in db fields))

 (defn edit [item pos]
-  (updatedb [:editor] (assoc (querydb [:editor]) pos item)))
+  (let [data (querydb [:data])]
+    (updatedb [:data] (assoc data pos item))))

-(defn update_field [id value]
-  (set! db (assoc-in db [:editor id] value)))
+(defn update_field [pos key value]
+  (let [item (assoc (querydb [:data pos]) key value)]
+    (set! db (assoc-in db [:data pos] item))))
+
+(defn save [item pos]
+  "Save item to db :data into position"
+  (let [doc (assoc item "mtime" (str (new js/Date)))
+        data (querydb [:data])]
+    (updatedb [:data] (assoc data pos doc))
+    (println "Saved!" (get doc "path"))))

 ;; Utils

@@ -58,12 +67,12 @@
 (defn annotate-editor
   [index item editing]
   (let [title (get editing "title")]
-    (nm "div" [(e/text "title" title 40 #(update_field index %))])))
+    (nm "div" [(e/text "title" title 40 #(update_field "title" index %))])))

 (defn annotate-button
-  [index item]
+  [pos item]
   (if (blob? item)
-    (nm "button.pure-button" {:onclick #(edit item index)} "Annotate")))
+    (nm "button.pure-button" {:onclick #(edit item pos)} "Annotate")))

 (defn annotate
   [index item]


only parse macros from cljs.core compiler

--- src/cljs_api_gen/parse.clj
+++ src/cljs_api_gen/parse.clj
@@ -366,17 +366,17 @@
       :else nil)))

 (defmethod parse-ns "cljs.core" [ns-]
-  ;; NOTE: Concatenation order is important here for allowing
-  ;; write/dump-doc-file! to overwrite previously defined
-  ;; macros/functions with subsequent ones.
+  ;; NOTE: Concatenation order is important here
+  ;; so previously defined macros/functions are overwritten
+  ;; by subsequent ones.
   ;; Many compiler macros share same names as library functions.
   ;; The library functions are intended to be used over the macros.
   ;; And the imported macros from "clojure.core" should be overwritten
   ;; by cljs.core's macros.
   (concat (parse-extra-macros-from-clj)
-          (parse-ns* ns- "clojurescript" [:compiler     ;; <-- again, order is important!
-                                          :library])))  ;; :library should come after :compiler
-                                                        ;; so the library functions overwrite compiler macros
+          (->> (parse-ns* ns- "clojurescript" [:compiler])
+               (filter #(= "macro" (:type %))))
+          (parse-ns* ns- "clojurescript" [:library])))

 ;; pseudo-namespace since special forms don't have a namespace
 (defmethod parse-ns "special" [ns-]


Add save-as-text-ile with the extra compression codec parameter

saveAsTextFile can take a optional third parameter specifying the compression codec to use to save files.

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -419,8 +419,10 @@
   in a given directory `path` in the local filesystem, HDFS or any other Hadoop-supported
   file system. Spark will call toString on each element to convert it to a line of
   text in the file."
-  [rdd path]
-  (.saveAsTextFile rdd path))
+  ([rdd path]
+   (.saveAsTextFile rdd path))
+  ([rrd path compression-codec]
+    (.saveAsTextFile rrd path compression-codec)))

 (defn save-as-sequence-file
   "Writes the elements of `rdd` as a Hadoop SequenceFile in a given `path`


Add with-coerce-param

Add with-coerce-param

--- src/clojure/gpu/matrix.clj
+++ src/clojure/gpu/matrix.clj
@@ -19,7 +19,7 @@
 (defmethod construct-matrix Number
   [data]
   (double data))
-(defmethod construct-matrix :default
+(defmethod construct-matrix clojure.lang.PersistentVector
   [data]
   (let [ndims (m/dimensionality data)
           shape (m/shape data)]
@@ -27,6 +27,13 @@
         (double-array (flatten data))
         ndims
         (long-array shape))))
+
+; assume it is an arbitary implementation
+; construct a persistent vector representation of the data
+(defmethod construct-matrix :default
+  [data]
+  (let [vm (mp/construct-matrix [] (m/shape data))]
+    (construct-matrix vm)))

 (extend-protocol mp/PImplementation
   NDArray
@@ -57,6 +64,15 @@
         (error (str "Invalid dimension! Expecting dimension to be between inclusive 0 and "
                     (dec ndims) ", but got " dimension-number "instead!"))
         (aget shape dimension-number)))))
+
+(extend-protocol mp/PCoercion
+  NDArray
+  (coerce-param [m param]
+    (cond (instance? NDArray param)
+          param
+          (number? param) (double param)
+          :else
+          (mp/construct-matrix m param))))

 (defn- all?
   "returns true if every element in coll (or the mapped version, if
@@ -271,17 +287,37 @@
       (count indexes) [m m] indexes
       (.set m (long-array indexes) v))))

-(extend-protocol PMatrixAdd
-  (matrix-add [m a]
-    (.add m m))
-  (matrix-sub [m b]
-    (.add m a)))
-
-(extend-protocol PMatrixMultiply
-  (element-multiply [m a]
-    (.mul m a)))
-
-(extend-protocol PMatrixDivide
-  (element-divide [m a]
-    (.div m a)))
-
+(defmacro with-coerce-param [bindings & body]
+  (assert (= (count bindings) 2))
+  (assert (symbol? (first bindings)))
+  (let [param-sym (first bindings)
+        param-val (second bindings)]
+    `(cond (number? ~param-val)
+           (let [~param-sym (double ~param-val)]
+             ~@body)
+           (instance? NDArray ~param-val)
+           (let [~(vary-meta param-sym assoc :tag `NDArray) ~param-val]
+             ~@body)
+           ; unkown type, we need to coerce it to NDArray
+           :else
+           (let [~(vary-meta param-sym assoc :tag `NDArray)
+                 (mp/coerce-param (gpu.matrix.NDArray/sample) ~param-val)]
+             ~@body))))
+
+(extend-protocol mp/PMatrixAdd
+  NDArray
+  (matrix-add [^NDArray m a]
+    (with-coerce-param [a a] (.add m a)))
+  (matrix-sub [^NDArray m a]
+    (with-coerce-param [a a] (.sub m a))))
+
+(extend-protocol mp/PMatrixMultiply
+  NDArray
+  (element-multiply [^NDArray m a]
+    (with-coerce-param [a a] (.mul m a))))
+
+(extend-protocol mp/PMatrixDivide
+  NDArray
+  (element-divide [^NDArray m a]
+    (with-coerce-param [a a] (.div m a))))
+


Added default error code.

Added default error code.


fix benches

fix benches

--- benches/fineman/benchmarks.clj
+++ benches/fineman/benchmarks.clj
@@ -19,6 +19,10 @@
    :try (fn [user] (:email user))})

 (def with-two-args
+  {:use (fn [user _] (:email user))
+   :try (fn [user _] (:email user))})
+
+(def with-three-args
   {:use (fn [user _] (:email user))
    :try (fn [user _] (:email user))})

@@ -45,8 +49,8 @@
       (science/run faster-experiment {:email "tom@tcrayford.com"} 1)))

   (bench "with-three-args"
-         (science/run with-two-args {:email "tom@tcrayford.com"} 1 2))
+         (science/run with-three-args {:email "tom@tcrayford.com"} 1 2))

-  (let [faster-experiment (science/make-it-faster! with-two-args)]
+  (let [faster-experiment (science/make-it-faster! with-three-args)]
     (bench "with-three-args-record"
       (science/run faster-experiment {:email "tom@tcrayford.com"} 1 2))))


Fixes bad interop calls.

Fixes bad interop calls.

--- src/onyx/interop.clj
+++ src/onyx/interop.clj
@@ -29,9 +29,9 @@
 (extend-protocol PipelineInput
   onyx.IPipelineInput
   (ack-segment [this event message-id]
-    (.ackMessage this event message-id))
+    (.ackSegment this event message-id))
   (retry-segment [this event message-id]
-    (.retryMessage this event message-id))
+    (.retrySegment this event message-id))
   (pending? [this event message-id]
     (.isPending this event message-id))
   (drained? [this event]


whitespace

whitespace

--- test/babel/test/es.cljc
+++ test/babel/test/es.cljc
@@ -28,7 +28,11 @@

 (deftest llamo
   (let [result (fo (engine/expression esg/small
-                                      {:synsem {:sem {:tense :present :aspect :progressive  :subj {:pred :I} :pred :be-called :obj {:pred :Juan}}}}))]
+                                      {:synsem {:sem {:tense :present
+                                                      :aspect :progressive
+                                                      :subj {:pred :I}
+                                                      :pred :be-called
+                                                      :obj {:pred :Juan}}}}))]
     (is (or (= result
                "yo me llamo Juan")
             (= result "me llamo Juan")))))


lein midje runs and reports on clojure.test tests.

--- leiningen/midje.clj
+++ leiningen/midje.clj
@@ -1,30 +1,70 @@
+;; -*- indent-tabs-mode: nil -*-
+
 (ns leiningen.midje
+  (:refer-clojure :exclude [test])
   (:use [leiningen.util.ns :only [namespaces-in-dir]]
         [leiningen.compile :only [eval-in-project]]))

 (defn require-namespaces-form [namespaces]
   `(do
      (require 'clojure.test)
+     (require 'clojure.string)
+
+     ;; This turns off "Testing ...." lines, which I hate, especially
+     ;; when there's no failure output.
+     (defmethod clojure.test/report :begin-test-ns [m#])
+
      (alter-var-root (var clojure.test/*report-counters*)
 		     (fn [_#] (ref clojure.test/*initial-report-counters*)))
      (doseq [n# '~namespaces] (require n#))
-     (let [passes# (:pass @clojure.test/*report-counters*)
-	   fails# (:fail @clojure.test/*report-counters*)
-           failure-message# (condp = fails#
-			       0 (format "All claimed facts (%d) have been confirmed." passes#)
-			       1 (format "FAILURE: %d fact was not confirmed." fails#)
-			       (format "FAILURE: %d facts were not confirmed." fails#))
-	   potential-consolation# (condp = passes#
-				      0 ""
-				      1 "(But 1 was.)"
-				      (format "(But %d were.)" passes#))
-	   consolation# (if (> fails# 0) potential-consolation# "")]
-       (println failure-message# consolation#))))
+
+     (let [midje-passes#    (:pass @clojure.test/*report-counters*)
+	   midje-fails#     (:fail @clojure.test/*report-counters*)
+           midje-failure-message#
+	      (condp = midje-fails#
+		  0 (format "All claimed facts (%d) have been confirmed." midje-passes#)
+		  1 (format "FAILURE: %d fact was not confirmed." midje-fails#)
+		  (format "FAILURE: %d facts were not confirmed." midje-fails#))
+	   potential-consolation#
+	       (condp = midje-passes#
+		   0 ""
+		   1 "(But 1 was.)"
+		   (format "(But %d were.)" midje-passes#))
+	   midje-consolation#
+	           (if (> midje-fails# 0) potential-consolation# "")
+
+	   ; Stashed clojure.test output
+	   clojure-test-output-catcher#
+	           (java.io.StringWriter.)
+	   clojure-test-result#
+   	           (binding [clojure.test/*test-out* clojure-test-output-catcher#]
+		     (apply ~'clojure.test/run-tests '~namespaces))
+	   clojure-test-output#
+    	           (-> clojure-test-output-catcher# .toString clojure.string/split-lines)]
+
+
+       (when (> (+ (:fail clojure-test-result#) (:error clojure-test-result#))
+		0)
+	 ;; For some reason, empty lines are swallowed, so I use >>> to
+         ;; demarcate sections.
+	 (println ">>> Output from clojure.test tests:")
+	 (dorun (map println (drop-last 2 clojure-test-output#))))
+
+       (when (> (:test clojure-test-result#) 0)
+	 (println ">>> clojure.test summary:")
+	 (dorun (map println (take-last 2 clojure-test-output#)))
+	 (println ">>> Midje summary:"))
+
+       (println midje-failure-message# midje-consolation#)
+
+       ;; A non-nil return value is printed, so I'll just exit here.
+       (System/exit (+ midje-fails#
+                       (:error clojure-test-result#)
+                       (:fail clojure-test-result#))))))

 (defn midje [project & namespaces]
   (let [desired-namespaces  (if (empty? namespaces)
-			      (concat (namespaces-in-dir (:test-path project))
-				      (namespaces-in-dir (:source-path project)))
-			      (map symbol namespaces))]
-    (eval-in-project project
-		     (require-namespaces-form desired-namespaces))))
+                              (concat (namespaces-in-dir (:test-path project))
+                                      (namespaces-in-dir (:source-path project)))
+                              (map symbol namespaces))]
+    (eval-in-project project (require-namespaces-form desired-namespaces))))


Allow for running all rules or a single rule via command line

--- src/rule110/core.clj
+++ src/rule110/core.clj
@@ -89,7 +89,7 @@
                            #_midi/play-grid))
               grid
               (range const/max-steps))
-      (Thread/sleep 100)
+      (Thread/sleep 300)
       (graphics/reset)))


equalize numeric types using BigDec

equalize numeric types using BigDec

--- test/transit/verify.clj
+++ test/transit/verify.clj
@@ -135,7 +135,9 @@

 (defn equalize [data]
   (walk/prewalk (fn [node]
-                  (cond (instance? java.lang.Long node)       (.doubleValue node)
+                  (cond (instance? java.lang.Long node)       (.stripTrailingZeros (bigdec node))
+                        (instance? java.math.BigInteger node) (.stripTrailingZeros (bigdec node))
+                        (instance? clojure.lang.BigInt node)  (.stripTrailingZeros (bigdec node))
                         (instance? java.math.BigDecimal node) (.stripTrailingZeros node)
                         (instance? java.util.Map$Entry node)  node
                         (sequential? node)                    (seq node)


working add-1 and add-2

working add-1 and add-2

--- test/tst/parse/demo.clj
+++ test/tst/parse/demo.clj
@@ -842,7 +842,6 @@

 ;*****************************************************************************
-;*****************************************************************************

 (dotest
   (let [abnf-src  (io/resource "yang3.abnf")
@@ -914,22 +913,17 @@
                 :content
                        [{:tag :x, :attrs {}, :content [2]}
                         {:tag :y, :attrs {}, :content [3]}]}]})
-
     (is= rpc-reply-enlive
       {:tag :rpc-reply, :attrs {:message-id 101, :xmlns "urn:ietf:params:xml:ns:netconf:base:1.0"}
        :content
             [{:tag :result, :attrs {}, :content [5]}]})
-
-
-
     (is= add-call
       {:tag     :add,
        :attrs   {:xmlns "my-own-ns/v1"},
        :content [{:tag :x, :attrs {}, :content [2]}
                  {:tag :y, :attrs {}, :content [3]}]})
     (is= add-params [{:tag :x, :attrs {}, :content [2]}
-                     {:tag :y, :attrs {}, :content [3]}])
-  ))
+                     {:tag :y, :attrs {}, :content [3]}]) ))

 ;                               ---------type-------------------   -------pattern------- (or reverse)
 ; #todo need function (conforms [:type [:identifier "decimal64"]] [:type [:identifier :*]]
@@ -950,53 +944,43 @@
                                   "  caused by=" (.getMessage e)))))))

 (defn validate-parse-leaf
-  "Validate & parse a leaf msg value given a leaf schema (Enlive-format)."
-  [schema val]
+  "Validate & parse a leaf msg value given a leaf leaf-schema (Enlive-format)."
+  [leaf-schema leaf-val]
   (try
-    (assert (= (grab :tag schema) :leaf))
-    (let [leaf-name-schema (keyword (get-leaf schema [:leaf :identifier]))
-          leaf-name-val    (grab :tag val)
+    (assert (= (grab :tag leaf-schema) :leaf))
+    (let [leaf-name-schema (keyword (get-leaf leaf-schema [:leaf :identifier]))
+          leaf-name-val    (grab :tag leaf-val)
           xx              (assert (= leaf-name-schema leaf-name-val))
           ; #todo does not yet verify any attrs;  what rules?
-          parser-fn       (leaf-schema->parser schema)
-          parsed-value    (parser-fn (only (grab :content val)))]
+          parser-fn       (leaf-schema->parser leaf-schema)
+          parsed-value    (parser-fn (only (grab :content leaf-val)))]
       parsed-value)
     (catch Exception e
-      (throw (RuntimeException. (str "validate-parse-val: failed for schema=" schema \newline
-                                  "  val=" val \newline
+      (throw (RuntimeException. (str "validate-parse-leaf-val: failed for leaf-schema=" leaf-schema \newline
+                                  "  leaf-val=" leaf-val \newline
                                   "  caused by=" (.getMessage e)))))))

 (def rpc-fn-map
-  {
-   :add  (fn fn-add [& args] (apply + args))
+  {:add  (fn fn-add [& args] (apply + args))
    :mult (fn fn-mult [& args] (apply * args))
-   :pow  (fn fn-power [x y] (Math/pow x y)) })
-
-(defn leaf-schema->parser
-  [schema]
+   :pow  (fn fn-power [x y] (Math/pow x y))})
+
+(defn validate-parse-rpc
+  "Validate & parse a rpc msg valueue given an rpc rpc-schema (Enlive-format)."
+  [rpc-schema rpc-msg]
   (try
-    (let [type      (get-leaf schema [:leaf :type :identifier]) ; eg "decimal64"
-          parser-fn (grab type parser-map)]
-      parser-fn)
-    (catch Exception e
-      (throw (RuntimeException. (str "leaf-schema->parser: failed for schema=" schema \newline
-                                  "  caused by=" (.getMessage e)))))))
-(defn validate-parse-rpc
-  "Validate & parse a rpc msg valueue given an rpc schema (Enlive-format)."
-  [schema value]
-  (try
-   ;(spyx-pretty schema)
-   ;(spyx-pretty value)
-    (assert (= :rpc (grab :tag schema) (grab :tag value)))
-    (let [rpc-attrs       (grab :attrs value)
-          rpc-tag-schema  (keyword (get-leaf schema [:rpc :identifier]))
-          rpc-value       (get-leaf value [:rpc])
+    ; (spyx-pretty rpc-schema)
+    ; (spyx-pretty rpc-msg)
+    (assert (= :rpc (grab :tag rpc-schema) (grab :tag rpc-msg)))
+    (let [rpc-attrs       (grab :attrs rpc-msg)
+          rpc-tag-schema  (keyword (get-leaf rpc-schema [:rpc :identifier]))
+          rpc-value       (get-leaf rpc-msg [:rpc])
           rpc-value-tag   (grab :tag rpc-value)
           rpc-value-attrs (grab :attrs rpc-value)
           xx              (assert (= rpc-tag-schema rpc-value-tag))
           ; #todo does not yet verify any attrs ;  what rules?
-          fn-args-schema  (grab :content (get-tree schema [:rpc :input]))
-          fn-args-value   (grab :content (get-tree value [:rpc rpc-value-tag]))
+          fn-args-schema  (grab :content (get-tree rpc-schema [:rpc :input]))
+          fn-args-value   (grab :content (get-tree rpc-msg [:rpc rpc-value-tag]))
           parsed-args     (mapv validate-parse-leaf fn-args-schema fn-args-value)
           rpc-fn          (grab rpc-value-tag rpc-fn-map)
           rpc-fn-result   (apply rpc-fn parsed-args)
@@ -1004,11 +988,11 @@
                            :attrs   rpc-attrs
                            :content [{:tag     :data
                                       :attrs   {}
-                                      :content [rpc-fn-result]}]} ]
-       rpc-result)
+                                      :content [rpc-fn-result]}]}]
+      rpc-result)
     (catch Exception e
-      (throw (RuntimeException. (str "validate-parse-leaf: failed for schema=" schema \newline
-                                  "  value=" value \newline
+      (throw (RuntimeException. (str "validate-parse-leaf: failed for rpc-schema=" rpc-schema \newline
+                                  "  rpc-msg=" rpc-msg \newline
                                   "  caused by=" (.getMessage e)))))))

 (def leaf-schema-1 (hiccup->enlive [:leaf [:identifier "x"] [:type [:identifier "decimal64"]]]))
@@ -1073,29 +1057,28 @@
 (def rpc-msg-id (atom 100))
 (def rpc-deliver-map (atom {}))

-
 (s/defn rpc-call-2 :- s/Any
   [msg :- tsk/KeyMap]
   (let [rpc-msg-id     (swap! rpc-msg-id inc)
         msg            (glue msg {:attrs {:message-id rpc-msg-id
                                           :xmlns      "urn:ietf:params:xml:ns:netconf:base:1.0"}})
-        result-promise (promise) ]
+        result-promise (promise)]
     (swap! rpc-deliver-map glue {rpc-msg-id result-promise}) ;  #todo temp!

-    (future ; Simulate calling out to http server in another thread
+    (future         ; Simulate calling out to http server in another thread
       (try
         (Thread/sleep *rpc-delay-simulated-ms*) ; simulated network delay
         (let [rpc-result        (validate-parse-rpc rpc-schema msg)
               rpc-reply-msg-id  (fetch-in rpc-result [:attrs :message-id])
               fpc-reply-promise (grab rpc-reply-msg-id @rpc-deliver-map)]
           (deliver fpc-reply-promise rpc-result))
-       (catch Exception e
-         (deliver result-promise ; deliver any exception to caller
-           (RuntimeException. (str "rpc-call-2: failed  msg=" msg \newline
-                                "  caused by=" (.getMessage e)))))))
-
-    result-promise ; return promise to caller immediately
-  ))
+        (catch Exception e
+          (deliver result-promise ; deliver any exception to caller
+            (RuntimeException. (str "rpc-call-2: failed  msg=" msg \newline
+                                 "  caused by=" (.getMessage e)))))))
+
+    result-promise  ; return promise to caller immediately
+    ))

 (defn add-2 [x y]
   (let [result-promise (rpc-call-2
@@ -1105,22 +1088,17 @@
                              [:x (str x)]
                              [:y (str y)]]]))
         rpc-result     (deref result-promise *rpc-timeout-ms* :timeout-failure)
-        _ (when (spyx (instance? Throwable rpc-result))
-             (throw (RuntimeException. (.getMessage rpc-result))))
+        _              (when (instance? Throwable rpc-result)
+                         (throw (RuntimeException. (.getMessage rpc-result))))
         result         (get-leaf rpc-result [:rpc-reply :data])]
-    (assert (= rpc-result)
-      [:rpc-reply {:message-id 101 :xmlns "urn:ietf:params:xml:ns:netconf:base:1.0"}
-       [:data 5.0]])
     (when (= :timeout-failure rpc-result)
       (throw (TimeoutException. (format "Timeout Exceed=%s  add: %s %s; " *rpc-timeout-ms* x y))))
     result))

 (dotest
-  (nl)
   (binding [*rpc-timeout-ms*         300
             *rpc-delay-simulated-ms* 10]
     (reset! rpc-msg-id 100)
-    (is (rel= 5 (spyx (add-2 2 3)) :digits 9)
-      ))
-)
-
+    (is (rel= 5 (spyx (add-2 2 3)) :digits 9))
+  ))
+


Switch to testing-specific user

Switch to testing-specific user

--- test/uruk/core_test.clj
+++ test/uruk/core_test.clj
@@ -8,7 +8,7 @@
 ;; FIXME You'll have to fill in database credentials that work for
 ;; your system:
 (def db {:uri "xdbc://localhost:8383/"
-         :user "rest-admin" :password "x"
+         :user "test-admin" :password "uruktesting"
          :content-base "TutorialDB"})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Load canonical-base in conexp.contrib.algorithms

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

--- src/conexp/contrib/algorithms.clj
+++ src/conexp/contrib/algorithms.clj
@@ -15,6 +15,7 @@

 (cm/defalias linclosure conexp.contrib.algorithms.linclosure/close-under-implications)

+(load "algorithms/canonical_base")
 (load "algorithms/concepts")

 ;;;


Enable zooming in popout window

Enable zooming in popout window

Adding missing parameter "about:blank" to opening window function.

--- src/day8/re_frame_10x/events.cljs
+++ src/day8/re_frame_10x/events.cljs
@@ -280,7 +280,7 @@
                               "</title>

")
         ;; We would like to set the windows left and top positions to match the monitor that it was on previously, but Chrome doesn't give us
         ;; control over this, it will only position it within the same display that it was popped out on.
-        w                (js/window.open "" "re-frame-10x-popout"
+        w                (js/window.open "about:blank" "re-frame-10x-popout"
                                          (str "width=" width ",height=" height ",left=" left ",top=" top
                                               ",resizable=yes,scrollbars=yes,status=no,directories=no,toolbar=no,menubar=no"))


color example fixed

color example fixed

--- src/examples/luxemburg.clj
+++ src/examples/luxemburg.clj
@@ -1,32 +1,31 @@
-(ns examples.luxemburg
-  (require [logic.util :refer :all]))
-
+(ns examples.luxemburg
+  (:require [logic.util :refer :all]))
+
 (def colors '[red green blue])

 (def countries '[lu de fr be])

-(defn one-color [country]
+(defn one-color [country colors]
   (oneof (map #(combine-syms country %) colors)))

-(def countries-one-color
-  (apply list 'and (map #(one-color %) countries)))
-￼￼￼
-(defn adjacent [c1 c2]
-  (apply list 'and
-    (map #(list 'or
-            (list 'not %1)
-            (list 'not %2))
-      (map #(combine-syms c1 %) colors)
-      (map #(combine-syms c2 %) colors))))
+(defn countries-one-color [countries colors]
+  (apply list 'and (map #(one-color % colors) countries)))

-(def fml
-  (list 'and
-    countries-one-color
-    (adjacent 'lu 'de)
-    (adjacent 'lu 'fr)
-    (adjacent 'lu 'be)
-    (adjacent 'de 'fr)
-    (adjacent 'fr 'be)
-    (adjacent 'be 'de)))
+(defn adjacent [c1 c2]
+  (apply list 'and (map #(list 'or (list 'not %1) (list 'not %2))
+                     (map #(combine-syms c1 %) colors)
+                     (map #(combine-syms c2 %) colors))))
+
+(def fml
+  (list 'and
+    (countries-one-color countries colors)
+    (adjacent 'lu 'de)
+    (adjacent 'lu 'fr)
+    (adjacent 'lu 'be)
+    (adjacent 'de 'fr)
+    (adjacent 'fr 'be)
+    (adjacent 'be 'de)))
+
+stop

 (-> fml transform-cnf generate-dimacs-clauses sat-solve)


Make sure future steps reflect the changes to the deployment

--- src/exploud/deployment.clj
+++ src/exploud/deployment.clj
@@ -289,9 +289,10 @@
   (let [deployment (store/get-deployment deployment-id)]
     (if (successful? task)
       (do (finish-task deployment task)
-          (if-let [next-task (task-after deployment task-id)]
-            (start-task deployment next-task)
-            (finish-deployment deployment)))
+          (let [deployment (store/get-deployment deployment-id)]
+            (if-let [next-task (task-after deployment task-id)]
+              (start-task deployment next-task)
+              (finish-deployment deployment))))
       (finish-deployment deployment))))

 ;; Pre-hook attached to `task-finished` to log parameters.


moved buttons over to img tag

moved buttons over to img tag

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -222,75 +222,63 @@

 (defn play-pause-button [data owner]
   (reify
-    om/IDidMount
-    (did-mount [this]
-      (.load (js/$ "#pause")
-        #(let [svg-doc (.-contentDocument  (. js/document (getElementById "pause")))
-               style-element (.createElementNS svg-doc "http://www.w3.org/2000/svg" "style")]
-          (set! (.-textContent style-element) "svg { fill: #96C8E9 }")
-          (.appendChild (. svg-doc  (getElementById  "Pause")) style-element))))
     om/IRender
     (render [this]
       (if (:paused? data)
-        (dom/div #js {:className "svg-player-button-clickable"
-                      :onClick core/resume}
-          (dom/object #js {:className "svg-player-button"
-                           :data "/images/player/play.svg"
-                           :title "Resume Track"}))
-
-        (dom/div #js {:id "pause-clickable"
-                      :className "svg-player-button-clickable"
-                      :onClick core/pause}
-          (dom/object #js {:id "pause"
-                           :className "svg-player-button"
-                           :data "/images/player/pause.svg"
-                           :title "Pause Track"}))))))
+        (dom/img #js {:id "resume"
+                      :className "player-button"
+                      :src "/images/player/play.svg"
+                      :title "Resume Track"
+                      :onClick core/resume})
+        (dom/img #js {:id "pause"
+                      :className "player-button"
+                      :src "/images/player/pause.svg"
+                      :title "Pause Track"
+                      :onClick core/pause})))))

 (defn previous-track-button [data owner]
   (reify
     om/IRender
     (render [this]
-      (dom/div #js {:className "svg-player-button-clickable"
-                    :onClick core/previous-track}
-        (dom/object #js {:className "svg-player-button"
-                         :data "/images/player/prev.svg"
-                         :title "Previous Track"})))))
+      (dom/img #js {:id "previous-track"
+                    :className "player-button"
+                    :src "/images/player/prev.svg"
+                    :title "Previous Track"
+                    :onClick core/previous-track}))))

 (defn next-track-button [data owner]
   (reify
     om/IRender
     (render [this]
-      (dom/div #js {:className "svg-player-button-clickable"
+      (dom/div #js {:className "player-button-clickable"
                     :onClick core/next-track}
-        (dom/object #js {:className "svg-player-button"
-                         :data "/images/player/next.svg"
-                         :title "Next Track"})))))
+        (dom/img #js {:id "next-track"
+                      :className "player-button"
+                      :src "/images/player/next.svg"
+                      :title "Next Track"
+                      :onClick core/next-track})))))

 (defn restart-button [data owner]
   (reify om/IRender
     (render [this]
-      (dom/div #js {:className "svg-player-button-clickable"
-                    :onClick core/restart-track}
-        (dom/object #js {:style #js {:transform "scale(-1, 1)"}
-                         :className "svg-player-button"
-                         :data "/images/player/restart.svg"
-                         :title "Restart Track"})))))
+      (dom/img #js {:style #js {:transform "scale(-1, 1)"}
+                    :className "player-button"
+                    :src "/images/player/restart.svg"
+                    :title "Restart Track"
+                    :onClick core/restart-track}))))

 (defn loop-button [data owner]
   (reify om/IRender
     (render [this]
       (if (:looping? data)
-        (dom/div #js {:className "svg-player-button-clickable"
-                      :onClick core/toggle-loop}
-          (dom/object #js {:className "svg-player-button"
-                           :data "/images/player/looping.svg"
-                           :title "Unloop Track"}))
-
-        (dom/div #js {:className "svg-player-button-clickable"
-                      :onClick core/toggle-loop}
-          (dom/object #js {:className "svg-player-button"
-                           :data "/images/player/looping.svg"
-                           :title "Loop Track"}))))))
+        (dom/img #js {:className "player-button"
+                      :src "/images/player/looping.svg"
+                      :title "Unloop Track"
+                      :onClick core/toggle-loop})
+        (dom/img #js {:className "player-button"
+                      :src "/images/player/looping.svg"
+                      :title "Loop Track"
+                      :onClick core/toggle-loop})))))

 (om/root play-pause-button player/app-state {:target (. js/document (getElementById "play-pause-button"))})
 (om/root previous-track-button core/app-state {:target (. js/document (getElementById "previous-track-button"))})


only run callbacks on entity instances

only run callbacks on entity instances

--- src/er_cassandra/model/select.clj
+++ src/er_cassandra/model/select.clj
@@ -33,11 +33,13 @@
      (mlet [strm (ms/-select-buffered session entity opts)]
        (->> strm
             (s/map (fn [mi]
-                     (t/run-callbacks-single
-                      entity
-                      :after-load
-                      mi
-                      opts)))
+                     (if (ms/entity-instance? mi)
+                       (t/run-callbacks-single
+                        entity
+                        :after-load
+                        mi
+                        opts)
+                       mi)))
             return))))

   ([^ModelSession session ^Entity entity key record-or-key-value]
@@ -48,11 +50,13 @@
      (mlet [strm (ms/-select-buffered session entity key record-or-key-value opts)]
        (->> strm
             (s/map (fn [mi]
-                     (t/run-callbacks-single
-                      entity
-                      :after-load
-                      mi
-                      opts)))
+                     (if (ms/entity-instance? mi)
+                       (t/run-callbacks-single
+                        entity
+                        :after-load
+                        mi
+                        opts)
+                       mi)))
             return)))))

 (defn select-one


Code refactor and removed unused collection

--- src/hatti/views/table.cljs
+++ src/hatti/views/table.cljs
@@ -95,16 +95,17 @@
       (generate-html
        (when value
          [:ul
-          [:li [:input {:type "checkbox"
-                        :data-id value
-                        :class "delete-record"}]]
+          [:li
+           [:input.delete-record {:type "checkbox"
+                                  :data-id value}]]
           [:li.tooltip.middle-right
            [:span.tip-info "View"]
            [:a.view-record
             [:i.fa.fa-eye {:data-id value}]]]
           [:li.tooltip
            [:span.tip-info "Edit"]
-           [:a.edit-record {:data-id value :target "_blank"
+           [:a.edit-record {:data-id value
+                            :target "_blank"
                             :href edit-link}
             [:i.fa.fa-pencil]]]])))))

@@ -219,7 +220,7 @@
         ; TODO: test using (:data-to-be-deleted @shared/app-state)
         selected-rows-count (get-elements-count-by-selector
                              (str delete-record-class-selector ":checked"))]
-    (if (= selected-rows-count total-rows-count) true false)))
+    (= selected-rows-count total-rows-count)))

 (defn get-checkbox-selector
   [data-id]
@@ -240,7 +241,6 @@
 (defn higlight-rows-marked-to-be-deleted
   [grid]
   (let [checkboxes (.getElementsByClassName js/document delete-record-class)
-        indexes (range (.-length checkboxes))
         indexes-of-selected-checkboxes (->> (map-indexed
                                              (fn [index checkbox]
                                                (when (.-checked checkbox)


Move card left if expanded version wouldn't fit on screen

--- frontend/src/faceboard/views/boards/people/card.cljs
+++ frontend/src/faceboard/views/boards/people/card.cljs
@@ -33,20 +33,23 @@
           extended? (and
                       (not filtered?)
                       (or (:extended? data) (= (anim-phase shrinking-anim) 0) (= (anim-phase shrinking-anim) 1)))
+          window-width (:width (get-current-window-dimensions))
+          padding 20
+          extended-card-width 480
+          cpx (:left layout)
+          card-right-edge (+ cpx extended-card-width)
+          card-left-edge cpx
           normal-transform #(when layout
-                             (str
-                               "translateX(" (:left layout) "px)"
-                               "translateY(" (:top layout) "px)"
-                               "translateZ(" (:z layout) "px)"))
+                             (let [corr-right (- card-right-edge (- window-width padding))
+                                   fixed-cpx-right (if (pos? corr-right) (- cpx corr-right) cpx)
+                                   fixed-cpx (if (neg? fixed-cpx-right) padding fixed-cpx-right)]
+                               (str
+                                 "translateX(" (if extended? fixed-cpx cpx) "px)"
+                                 "translateY(" (:top layout) "px)"
+                                 "translateZ(" (:z layout) "px)")))
           ; snappy transform is active in editing mode the goal is to keep one card in the center of attention
           ; also moving it left/right to make room for currently opened gizmo
-          snappy-transform #(let [padding 40
-                                  card-width 480
-                                  cpx (:left layout)
-                                  card-right-edge (+ cpx card-width)
-                                  card-left-edge cpx
-                                  window-width (:width (get-current-window-dimensions))
-                                  left? (and (:active gizmo) (= (:position gizmo) :left))
+          snappy-transform #(let [left? (and (:active gizmo) (= (:position gizmo) :left))
                                   right? (and (:active gizmo) (= (:position gizmo) :right))
                                   diff-right (- (+ card-right-edge max-gizmo-width-right) (- window-width padding))
                                   diff-left (- card-left-edge max-gizmo-width-left)


(maint) Add generic `write-certs-and-crls` testutil

This commit adds a `write-certs-and-crls` function that takes lists of certs
and CRLs as parameters. This allows the more-specific generation functions to
create the relevant certs and CRLS and then call this generic write function.

--- test/puppetlabs/ssl_utils/testutils.clj
+++ test/puppetlabs/ssl_utils/testutils.clj
@@ -175,49 +175,44 @@
 ;; Within the repl, run the following (with your desired function and arguments):
 ;; ```
 ;; (require '[puppetlabs.ssl-utils.testutils :as t])
-;; (t/write-cert-chain-and-crls 3 "your-subpath")
+;; (t/write-valid-cert-chain-and-crls 3 "your-subpath")
 ;; ```

 (def test-files-path "test-resources/puppetlabs/ssl_utils/examples/ssl")

-(defn write-cert-chain-and-crls
-  [number-of-certs test-subpath]
+(defn write-certs-and-crls
+  [certs crls test-subpath certs-filename crls-filename]
   (let [dir-path (fs/file test-files-path test-subpath)
-        certs-path (fs/file dir-path (str number-of-certs "-cert-chain.pem"))
-        crls-path (fs/file dir-path (str number-of-certs "-crl-chain.pem"))
-        [certs crls] (generate-cert-chain-with-crls number-of-certs)]
+        certs-path (fs/file dir-path certs-filename)
+        crls-path (fs/file dir-path crls-filename)]
     (fs/mkdirs dir-path)
     (objs->pem! certs certs-path)
     (objs->pem! crls crls-path)))

+(defn write-valid-cert-chain-and-crls
+  [number-of-certs test-subpath]
+  (let [certs-filename (str number-of-certs "-cert-chain.pem")
+        crls-filename (str number-of-certs "-crl-chain.pem")
+        [certs crls] (generate-cert-chain-with-crls number-of-certs)]
+    (write-certs-and-crls certs crls test-subpath certs-filename crls-filename)))
+
 (defn write-expired-crl
   [test-subpath]
-  (let [dir-path (fs/file test-files-path test-subpath)
-        cert-path (fs/file dir-path "cert-with-expired-crl.pem")
-        crl-path (fs/file dir-path "expired-crl.pem")
-        [cert expired-crl] (generate-cert-chain-with-crls
-                            1 generate-expired-crl)]
-    (fs/mkdirs dir-path)
-    (objs->pem! cert cert-path)
-    (objs->pem! expired-crl crl-path)))
+  (let [cert-filename "cert-with-expired-crl.pem"
+        crl-filename "expired-crl.pem"
+        [cert expired-crl] (generate-cert-chain-with-crls 1 generate-expired-crl)]
+    (write-certs-and-crls cert expired-crl test-subpath cert-filename crl-filename)))

 (defn write-not-yet-valid-crl
   [test-subpath]
-  (let [dir-path (fs/file test-files-path test-subpath)
-        cert-path (fs/file dir-path "cert-with-not-valid-crl.pem")
-        crl-path (fs/file dir-path "not-yet-valid-crl.pem")
+  (let [cert-filename "cert-with-not-valid-crl.pem"
+        crl-filename "not-yet-valid-crl.pem"
         [cert crl] (generate-cert-chain-with-crls 1 generate-not-yet-valid-crl)]
-    (fs/mkdirs dir-path)
-    (objs->pem! cert cert-path)
-    (objs->pem! crl crl-path)))
+    (write-certs-and-crls cert crl test-subpath cert-filename crl-filename)))

 (defn write-crl-with-bad-sig
   [test-subpath]
-  (let [dir-path (fs/file test-files-path test-subpath)
-        cert-path (fs/file dir-path "cert-with-crl-bad-sig.pem")
-        crl-path (fs/file dir-path "crl-with-bad-signature.pem")
-        [cert bad-crl] (generate-cert-chain-with-crls
-                        1 generate-crl-with-bad-signature)]
-    (fs/mkdirs dir-path)
-    (objs->pem! cert cert-path)
-    (objs->pem! bad-crl crl-path)))+  (let [cert-filename "cert-with-crl-bad-sig.pem"
+        crl-filename "crl-with-bad-signature.pem"
+        [cert bad-crl] (generate-cert-chain-with-crls 1 generate-crl-with-bad-signature)]
+    (write-certs-and-crls cert bad-crl test-subpath cert-filename crl-filename)))


(SERVER-797) Use jruby mocking in jruby-puppet-service tests

This commit uses jruby mocking in the jruby-puppet-service tests,
separated out from other commits for a little better reviewability.

--- test/unit/puppetlabs/services/jruby/jruby_puppet_service_test.clj
+++ test/unit/puppetlabs/services/jruby/jruby_puppet_service_test.clj
@@ -21,9 +21,7 @@

 (def default-services
   [jruby-puppet-pooled-service
-   jruby-pool-manager-service
    profiler/puppet-profiler-service])
-

 (deftest facter-jar-loaded-during-init
   (testing (str "facter jar found from the ruby load path is properly "
@@ -31,212 +29,208 @@
     (let [temp-dir (ks/temp-dir)
           facter-jar (-> temp-dir
                        (fs/file jruby-puppet-core/facter-jar)
-                       (ks/absolute-path))]
+                       (ks/absolute-path))
+          config (assoc-in (jruby-service-test-config 1)
+                           [:jruby-puppet :ruby-load-path]
+                           (into [] (cons (ks/absolute-path temp-dir)
+                                          jruby-testutils/ruby-load-path)))]
       (fs/touch facter-jar)
       (bootstrap/with-app-with-config
         app
-        default-services
-        (assoc-in (jruby-service-test-config 1)
-          [:jruby-puppet :ruby-load-path]
-          (into [] (cons (ks/absolute-path temp-dir)
-                     jruby-testutils/ruby-load-path)))
-        ;; This test doesn't technically need to wait for jruby pool
-        ;; initialization to be done but if it doesn't, the pool initialization
-        ;; may continue on during the execution of a subsequent test and
-        ;; interfere with the next test's results.  This wait ensures that the
-        ;; pool initialization agent will be dormant by the time this test
-        ;; finishes.  It should be possible to remove this when SERVER-1087 is
-        ;; resolved.
-        (jruby-testutils/wait-for-jrubies app)
+        (conj default-services
+              (jruby-testutils/mock-jruby-pool-manager-service config))
+        config
         (is (true? (some #(= facter-jar (.getFile %))
                      (.getURLs (ClassLoader/getSystemClassLoader)))))))))

 (deftest environment-class-info-tags
   (testing "environment-class-info-tags cache has proper data"
-    (bootstrap/with-app-with-config
-     app
-     default-services
-     (jruby-service-test-config 1)
-     (let [service (app/get-service app :JRubyPuppetService)
-           production-cache-id-before-first-update
-           (jruby-protocol/get-environment-class-info-cache-generation-id!
-            service
-            "production")]
-       (testing "when environment not previously loaded to cache"
-         (is (nil? (jruby-protocol/get-environment-class-info-tag
-                    service
-                    "production")))
-         (is (= 1 production-cache-id-before-first-update)))
-       (testing "when environment info first set to cache"
-         (jruby-protocol/set-environment-class-info-tag!
-          service
-          "production"
-          "1234prod"
-          production-cache-id-before-first-update)
-         (is (= "1234prod" (jruby-protocol/get-environment-class-info-tag
-                            service
-                            "production")))
-         (is (nil? (jruby-protocol/get-environment-class-info-tag
-                    service
-                    "test")))
-         (jruby-protocol/set-environment-class-info-tag!
-          service
-          "test"
-          "1234test"
-          (jruby-protocol/get-environment-class-info-cache-generation-id!
-           service
-           "test"))
-         (is (= "1234prod" (jruby-protocol/get-environment-class-info-tag
-                            service
-                            "production")))
-         (is (= "1234test" (jruby-protocol/get-environment-class-info-tag
-                            service
-                            "test"))))
-       (let [production-cache-id-after-first-update
+    (let [config (jruby-service-test-config 1)]
+      (bootstrap/with-app-with-config
+       app
+       (conj default-services
+             (jruby-testutils/mock-jruby-pool-manager-service config))
+       config
+       (let [service (app/get-service app :JRubyPuppetService)
+             production-cache-id-before-first-update
              (jruby-protocol/get-environment-class-info-cache-generation-id!
               service
-              "production")
-             test-cache-id-after-first-update
-             (jruby-protocol/get-environment-class-info-cache-generation-id!
-              service
-              "test")]
-         (testing "when environment info reset in the cache"
-           (is (= 2 production-cache-id-after-first-update))
-           (is (= 2 test-cache-id-after-first-update))
+              "production")]
+         (testing "when environment not previously loaded to cache"
+           (is (nil? (jruby-protocol/get-environment-class-info-tag
+                      service
+                      "production")))
+           (is (= 1 production-cache-id-before-first-update)))
+         (testing "when environment info first set to cache"
            (jruby-protocol/set-environment-class-info-tag!
             service
             "production"
-            "5678prod"
-            production-cache-id-after-first-update)
-           (is (= "5678prod" (jruby-protocol/get-environment-class-info-tag
+            "1234prod"
+            production-cache-id-before-first-update)
+           (is (= "1234prod" (jruby-protocol/get-environment-class-info-tag
+                              service
+                              "production")))
+           (is (nil? (jruby-protocol/get-environment-class-info-tag
+                      service
+                      "test")))
+           (jruby-protocol/set-environment-class-info-tag!
+            service
+            "test"
+            "1234test"
+            (jruby-protocol/get-environment-class-info-cache-generation-id!
+             service
+             "test"))
+           (is (= "1234prod" (jruby-protocol/get-environment-class-info-tag
                               service
                               "production")))
            (is (= "1234test" (jruby-protocol/get-environment-class-info-tag
                               service
-                              "test")))
-           (is (= test-cache-id-after-first-update
-                  (jruby-protocol/get-environment-class-info-cache-generation-id!
-                   service
-                   "test")))
-           (testing "and environment expired between get and corresponding set"
-             (let [production-cache-id-before-marked-expired
-                   (jruby-protocol/get-environment-class-info-cache-generation-id!
-                    service
-                    "production")
-                   _ (jruby-protocol/mark-environment-expired! service
-                                                               "production")
-                   production-cache-id-after-marked-expired
-                   (jruby-protocol/get-environment-class-info-cache-generation-id!
-                    service
-                    "production")]
-               (is (not= production-cache-id-after-first-update
-                         production-cache-id-before-marked-expired))
-               (is (not= production-cache-id-before-marked-expired
-                         production-cache-id-after-marked-expired))
-               (is (= nil (jruby-protocol/get-environment-class-info-tag
-                           service
-                           "production"))
-                   (str "Tag was unexpectedly non-nil, however, it should have "
-                        "been because of the prior call to "
-                        "`mark-environment-expired`"))
-               (jruby-protocol/set-environment-class-info-tag!
-                service
-                "production"
-                "89abprod"
-                production-cache-id-before-marked-expired)
-               (is (= nil (jruby-protocol/get-environment-class-info-tag
-                           service
-                           "production"))
-                   (str "Tag should not have been changed by the prior set "
-                        "since the environment was marked expired after the "
-                        "cache was read for "
-                        "`production-cache-id-before-marked-expired`"))
-               (is (= production-cache-id-after-marked-expired
-                      (jruby-protocol/get-environment-class-info-cache-generation-id!
-                       service
-                       "production"))
-                   (str "Cache id should not have been changed by the prior "
-                        "set since the environment was marked expired after "
-                        "cache was read for "
-                        "`production-cache-id-before-marked-expired`")))))
-         (testing "when an individual environment is marked expired"
-           (let [production-cache-id-before-marked-expired
-                 (jruby-protocol/get-environment-class-info-cache-generation-id!
-                  service
-                  "production")]
-             (jruby-protocol/mark-environment-expired! service "production")
-             (is (nil? (jruby-protocol/get-environment-class-info-tag
-                        service
-                        "production")))
-             (is (not= production-cache-id-before-marked-expired
-                       (jruby-protocol/get-environment-class-info-cache-generation-id!
-                        service
-                        "production"))))
-           (is (= "1234test" (jruby-protocol/get-environment-class-info-tag
-                              service
-                              "test")))
-           (is (= test-cache-id-after-first-update
-                  (jruby-protocol/get-environment-class-info-cache-generation-id!
-                   service
-                   "test"))))
-         (testing "when all environments are marked expired"
-           (let [production-cache-id-before-set-tag
-                 (jruby-protocol/get-environment-class-info-cache-generation-id!
-                  service
-                  "production")]
+                              "test"))))
+         (let [production-cache-id-after-first-update
+               (jruby-protocol/get-environment-class-info-cache-generation-id!
+                service
+                "production")
+               test-cache-id-after-first-update
+               (jruby-protocol/get-environment-class-info-cache-generation-id!
+                service
+                "test")]
+           (testing "when environment info reset in the cache"
+             (is (= 2 production-cache-id-after-first-update))
+             (is (= 2 test-cache-id-after-first-update))
              (jruby-protocol/set-environment-class-info-tag!
               service
               "production"
-              "8910prod"
-              production-cache-id-before-set-tag)
-             (is (= "8910prod" (jruby-protocol/get-environment-class-info-tag
+              "5678prod"
+              production-cache-id-after-first-update)
+             (is (= "5678prod" (jruby-protocol/get-environment-class-info-tag
                                 service
-                                "production"))))
-           (let [production-cache-id-before-marked-expired
-                 (jruby-protocol/get-environment-class-info-cache-generation-id!
-                  service
-                  "production")]
-             (jruby-protocol/mark-all-environments-expired! service)
-             (is (nil? (jruby-protocol/get-environment-class-info-tag
-                        service
-                        "production")))
-             (is (not= production-cache-id-before-marked-expired
-                       (jruby-protocol/get-environment-class-info-cache-generation-id!
-                        service
-                        "production")))
-             (is (nil? (jruby-protocol/get-environment-class-info-tag service
-                                                                      "test")))
-             (is (not= test-cache-id-after-first-update
-                       (jruby-protocol/get-environment-class-info-cache-generation-id!
-                        service
-                        "test")))))
-         (testing (str "when all environments expired between get and set "
-                       "for environment that did not previously exist")
-           (let [staging-cache-id-before-marked-expired
-                 (jruby-protocol/get-environment-class-info-cache-generation-id!
-                  service
-                  "staging")
-                 _ (jruby-protocol/mark-all-environments-expired! service)
-                 staging-cache-id-after-marked-expired
-                 (jruby-protocol/get-environment-class-info-cache-generation-id!
-                  service
-                  "staging")]
-             (jruby-protocol/set-environment-class-info-tag!
-              service
-              "staging"
-              "1234staging"
-              staging-cache-id-before-marked-expired)
-             (is (= nil (jruby-protocol/get-environment-class-info-tag
-                         service
-                         "staging"))
-                 (str "Tag should not have been changed by the prior set "
-                      "since the environment was marked expired after the "
-                      "`staging-cache-id-before-marked-expired` was read"))
-             (is (= staging-cache-id-after-marked-expired
+                                "production")))
+             (is (= "1234test" (jruby-protocol/get-environment-class-info-tag
+                                service
+                                "test")))
+             (is (= test-cache-id-after-first-update
                     (jruby-protocol/get-environment-class-info-cache-generation-id!
                      service
-                     "staging"))
-                 (str "Cache id should not have been changed by the prior "
-                      "set since the environment was marked expired after the "
-                      "`staging-cache-id-before-marked-expired` was "
-                      "read")))))))))
+                     "test")))
+             (testing "and environment expired between get and corresponding set"
+               (let [production-cache-id-before-marked-expired
+                     (jruby-protocol/get-environment-class-info-cache-generation-id!
+                      service
+                      "production")
+                     _ (jruby-protocol/mark-environment-expired! service
+                                                                 "production")
+                     production-cache-id-after-marked-expired
+                     (jruby-protocol/get-environment-class-info-cache-generation-id!
+                      service
+                      "production")]
+                 (is (not= production-cache-id-after-first-update
+                           production-cache-id-before-marked-expired))
+                 (is (not= production-cache-id-before-marked-expired
+                           production-cache-id-after-marked-expired))
+                 (is (= nil (jruby-protocol/get-environment-class-info-tag
+                             service
+                             "production"))
+                     (str "Tag was unexpectedly non-nil, however, it should have "
+                          "been because of the prior call to "
+                          "`mark-environment-expired`"))
+                 (jruby-protocol/set-environment-class-info-tag!
+                  service
+                  "production"
+                  "89abprod"
+                  production-cache-id-before-marked-expired)
+                 (is (= nil (jruby-protocol/get-environment-class-info-tag
+                             service
+                             "production"))
+                     (str "Tag should not have been changed by the prior set "
+                          "since the environment was marked expired after the "
+                          "cache was read for "
+                          "`production-cache-id-before-marked-expired`"))
+                 (is (= production-cache-id-after-marked-expired
+                        (jruby-protocol/get-environment-class-info-cache-generation-id!
+                         service
+                         "production"))
+                     (str "Cache id should not have been changed by the prior "
+                          "set since the environment was marked expired after "
+                          "cache was read for "
+                          "`production-cache-id-before-marked-expired`")))))
+           (testing "when an individual environment is marked expired"
+             (let [production-cache-id-before-marked-expired
+                   (jruby-protocol/get-environment-class-info-cache-generation-id!
+                    service
+                    "production")]
+               (jruby-protocol/mark-environment-expired! service "production")
+               (is (nil? (jruby-protocol/get-environment-class-info-tag
+                          service
+                          "production")))
+               (is (not= production-cache-id-before-marked-expired
+                         (jruby-protocol/get-environment-class-info-cache-generation-id!
+                          service
+                          "production"))))
+             (is (= "1234test" (jruby-protocol/get-environment-class-info-tag
+                                service
+                                "test")))
+             (is (= test-cache-id-after-first-update
+                    (jruby-protocol/get-environment-class-info-cache-generation-id!
+                     service
+                     "test"))))
+           (testing "when all environments are marked expired"
+             (let [production-cache-id-before-set-tag
+                   (jruby-protocol/get-environment-class-info-cache-generation-id!
+                    service
+                    "production")]
+               (jruby-protocol/set-environment-class-info-tag!
+                service
+                "production"
+                "8910prod"
+                production-cache-id-before-set-tag)
+               (is (= "8910prod" (jruby-protocol/get-environment-class-info-tag
+                                  service
+                                  "production"))))
+             (let [production-cache-id-before-marked-expired
+                   (jruby-protocol/get-environment-class-info-cache-generation-id!
+                    service
+                    "production")]
+               (jruby-protocol/mark-all-environments-expired! service)
+               (is (nil? (jruby-protocol/get-environment-class-info-tag
+                          service
+                          "production")))
+               (is (not= production-cache-id-before-marked-expired
+                         (jruby-protocol/get-environment-class-info-cache-generation-id!
+                          service
+                          "production")))
+               (is (nil? (jruby-protocol/get-environment-class-info-tag service
+                                                                        "test")))
+               (is (not= test-cache-id-after-first-update
+                         (jruby-protocol/get-environment-class-info-cache-generation-id!
+                          service
+                          "test")))))
+           (testing (str "when all environments expired between get and set "
+                         "for environment that did not previously exist")
+             (let [staging-cache-id-before-marked-expired
+                   (jruby-protocol/get-environment-class-info-cache-generation-id!
+                    service
+                    "staging")
+                   _ (jruby-protocol/mark-all-environments-expired! service)
+                   staging-cache-id-after-marked-expired
+                   (jruby-protocol/get-environment-class-info-cache-generation-id!
+                    service
+                    "staging")]
+               (jruby-protocol/set-environment-class-info-tag!
+                service
+                "staging"
+                "1234staging"
+                staging-cache-id-before-marked-expired)
+               (is (= nil (jruby-protocol/get-environment-class-info-tag
+                           service
+                           "staging"))
+                   (str "Tag should not have been changed by the prior set "
+                        "since the environment was marked expired after the "
+                        "`staging-cache-id-before-marked-expired` was read"))
+               (is (= staging-cache-id-after-marked-expired
+                      (jruby-protocol/get-environment-class-info-cache-generation-id!
+                       service
+                       "staging"))
+                   (str "Cache id should not have been changed by the prior "
+                        "set since the environment was marked expired after the "
+                        "`staging-cache-id-before-marked-expired` was "
+                        "read"))))))))))


Bump JSHint version to the 2.5.8

Bump JSHint version to the 2.5.8

--- src/lein_jshint/plugin.clj
+++ src/lein_jshint/plugin.clj
@@ -9,7 +9,7 @@
 ; Internal API: Configuration

 (def ^:private DEF_JSHINT_DEP "jshint")
-(def ^:private DEF_JSHINT_VER ">=2.5.5")
+(def ^:private DEF_JSHINT_VER ">=2.5.8")

 ; Internal API: Middlewares


Fix previous commit

Fix previous commit

--- src/lein_jshint/plugin.clj
+++ src/lein_jshint/plugin.clj
@@ -14,7 +14,8 @@

 (defn compile-hook [task project & args]
   (let [res (apply task project args)]
-    (jshint/jshint project)))
+    (jshint/jshint project)
+    res))

 (defn activate []
   (npm/hooks)


Add some comments.

Add some comments.

--- src/my_noir_lab/views/welcome.clj
+++ src/my_noir_lab/views/welcome.clj
@@ -8,12 +8,14 @@
   (common/layout
    [:p "Welcome to my-noir-lab"]))

+;; Hello world
 (defpage "/my-page" []
   (common/site-layout
    "Welcome"
    [:h1 "Hello"]
    [:p#wrapper "Hope you like it!"]))

+;; A page to display the input
 (defpage "/range" {:as user}
   (common/site-layout
    "Range input"
@@ -22,9 +24,11 @@
             (common/input-fields-range user)
             (submit-button "submit"))))

+;; A page to display the range
 (defpage [:post "/range"] {:keys [start end] :as user}
   (common/site-layout
    "Range"
    [:h2 (str "Display range from " start " to " end)]
    [:p#wrapper (map #(str % "<br />")
-                    (range (read-string start) (read-string end)))]))
+                    (range (read-string start) (read-string end)))])
+  (render "/range" user))


Uberjar

Uberjar

--- mtg-pairings-server/project.clj
+++ mtg-pairings-server/project.clj
@@ -14,4 +14,5 @@
                  [org.postgresql/postgresql "9.2-1002-jdbc4"]]
   :main mtg-pairings-server.server
   :profiles {:dev {:source-paths ["dev"]
-                   :dependencies [[org.clojure/tools.namespace "0.2.4"]]}})
+                   :dependencies [[org.clojure/tools.namespace "0.2.4"]]}
+             :uberjar {:aot [mtg-pairings-server.server]}})


testing user creating machine for another user without permission

--- test/celestial/integration/persistency/persmissions.clj
+++ test/celestial/integration/persistency/persmissions.clj
@@ -64,5 +64,11 @@
           (s/delete-system id) => [1 1 1]
           (provided (current-user) => {:username "ronen"} :times 6)
           (s/add-system redis-prox-spec) => truthy
-          (provided (current-user) => {:username "ronen"} :times 6))))))
+          (provided (current-user) => {:username "ronen"} :times 6)))
+
+      (fact "user trying to create on another username" :integration :redis :systems
+         (s/add-system (assoc redis-prox-spec :user "foo")) =>
+           (throws ExceptionInfo (is-type? :celestial.persistency.systems/persmission-violation))
+         (provided
+           (current-user) => {:username "ronen"} :times 2)))))


Cleanup

Cleanup

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -140,7 +140,6 @@
                                                                         %))))))

        :paginate     (fn paginate-query [query-builder [limit m]]
-                       (println m)
                        (-> query-builder
                            (where-clause  m)
                            (.limit limit)))