Use the new low level API for non-pure handlers.

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -62,8 +62,8 @@

 ;; -- event handlers  ----------------------------------------------------------------------------

-(handlers/register     ;; not pure
-  :undo                ;; usage:  (dispatch [:undo])
+(handlers/register-base     ;; not a pure handler
+  :undo                     ;; usage:  (dispatch [:undo])
   (fn handler
     [_ _]
     (when (undos?)
@@ -72,8 +72,8 @@
       (reset! undo-list (pop @undo-list)))))

-(handlers/register     ;; not pure
-  :redo                ;; usage:  (dispatch [:redo])
+(handlers/register-base     ;; not a pure handler
+  :redo                     ;; usage:  (dispatch [:redo])
   (fn handler
     [_ _]
     (when (redos?)


config/async-queue!: docstring points to executor-service.

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -173,6 +173,8 @@
   configuration time--preferably once for each distinct IO-bound asynchronous
   service.

+  See `riemann.service/threadpool-service` for options.
+
   Example:

   (let [graph (async-queue! :graphite {:queue-size 100}


Test run-logic-query not assuming hardcoded 'x

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -171,7 +171,13 @@
     (list clojure.core.logic/featurec
           (#'q/free-sym 'x)
           {:ip "10.0.0.1"})
+    [[{:ip "10.0.0.1"}]]
+
+    (list clojure.core.logic/featurec
+          (#'q/free-sym 'y)
+          {:ip "10.0.0.1"})
     [[{:ip "10.0.0.1"}]])
+
   (testing "explicit maximum number of results"
     (let [results [[{:ip "10.0.0.1"}]]
           query (list clojure.core.logic/featurec


extract chord-prog and other useful variables from the extemp logic so they're easier to play about with

--- test/example/extemp_piano.clj
+++ test/example/extemp_piano.clj
@@ -23,28 +23,31 @@
 ;;                  (random '(2 7 10))
 ;;                  (random '(0 8))))))

+(def instrument piano)
+(def metro (metronome 20))

 (def beat-offsets [0 0.1 1/3  0.7 0.9])
-(def instrument piano)
-(def metro (metronome 20))
+(def chord-prog
+  [#{[2 :minor7] [7 :minor7] [10 :major7]}
+   #{[0 :minor7] [8 :major7]}])
+(def root 40)
+(def max-range 35)
+(def range-variation 10)
+(def range-period 8)

 ;;this assumes you have the mda-piano available. Feel fre to eplace piano with
 ;;a different synth which accepts a MIDI note as its first arg such as tb303.
 ;;(def instrument tb303)
-
 (defn beat-loop
-  [metro beat root]
-  (let [chord-name (if (some #{10 8} [root])
-                     :major7
-                     :minor7)
-        next-root  (if (some #{0 8} [root])
-                     (choose [2 7 10])
-                     (choose [0 8]))]
-    (dorun (map (fn [note offset]
-                  (at (metro (+ beat offset)) (instrument note)))
-                (rand-chord (+ 40 root) chord-name (count beat-offsets) (cosr beat 35 10 32) )
-                beat-offsets))
-    (apply-at (metro (inc beat)) #'beat-loop [metro (inc beat) next-root])))
+  [metro beat chord-idx]
+  (let [[tonic chord-name] (choose (seq (nth chord-prog chord-idx)))
+        nxt-chord-idx     (mod (inc chord-idx) (count chord-prog))]
+    (dorun
+     (map (fn [note offset]
+            (at (metro (+ beat offset)) (instrument note)))
+          (rand-chord (+ root tonic) chord-name (count beat-offsets) (cosr beat max-range range-variation range-period) )
+          beat-offsets))
+    (apply-at (metro (inc beat)) #'beat-loop [metro (inc beat) nxt-chord-idx])))

 ;;start the music:
 (beat-loop metro (metro) 0)


refactoring

refactoring

--- test/pathfinder/core_test.clj
+++ test/pathfinder/core_test.clj
@@ -40,20 +40,28 @@
   (t/trace-env)
   (some-inner-fn a b 3))

+(defn assert-threads-tracks
+  [n generate-threads-fn]
+  (reset! db [])
+  (generate-threads-fn n)
+  (let [tracks-by-path (group-by :path-id @db)]
+    ;; in every path there is 2 tracks (for two fns)
+    (is (->>
+         tracks-by-path
+         vals
+         (map count)
+         (every? #(= % 2))))
+    ;; there is N track groups (aka paths)
+    (is (= n (count tracks-by-path)))))
+
+(defn generate-futures
+  [n]
+  (let [fs (mapv
+            (fn [_] (future (test-fn 1 2)))
+            (range n))]
+    (while (not (every? realized? fs))
+      (Thread/sleep 100))))
+
 (deftest future-threads-test
   (testing "N futures should produce N different paths"
-    (let [n 10
-          futures (map
-                   (fn [_] (future (test-fn 1 2)))
-                   (range n))]
-      (while (not (every? realized? futures))
-        (Thread/sleep 100))
-      (let [tracks-by-path (group-by :path-id @db)]
-        ;; in every path there is 2 tracks (for two fns)
-        (is (->>
-             tracks-by-path
-             vals
-             (map count)
-             (every? #(= % 2))))
-        ;; there is N track groups (aka paths)
-        (is (= n (count tracks-by-path)))))))
+    (assert-threads-tracks 20 generate-futures)))


Streams test: clean up some debugging prns

--- test/reimann/test/streams.clj
+++ test/reimann/test/streams.clj
@@ -327,7 +327,6 @@
                  o (dosync (deref output))]

              ; All events recorded
-             (prn o)
              (is (approx-equal total (reduce + (map :metric o))))

              )))
@@ -367,7 +366,6 @@
                          state (ref nil)]
                      (fn [event]
                        (dosync
-                         (prn "recv " event)
                          (alter i inc)

                          (is (not= (deref state) (:state event)))


Rename dataset.

Rename dataset.

--- src/stuttaford/web/routes.clj
+++ src/stuttaford/web/routes.clj
@@ -45,8 +45,8 @@
    :css     ["bootstrap/css/bootstrap.min.css" "css/radiant.css"]
    :content (list (om-app "radiant" debug?
                           {:data-sources
-                           {:links {:id     :links
-                                    :label  "Links"
+                           {:links {:id     :codex
+                                    :label  "Codex"
                                     :datoms (db/all-datoms-for-radiant)}}}))})

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


add a button for blog in main menu

add a button for blog in main menu

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -130,6 +130,11 @@
                           :role "button"}
             (common/icon :command)
             [:span "Shortcuts"]]
+           [:a.menu-item {:href "/blog"
+                          :target "_blank"
+                          :role "button"}
+            (common/icon :command)
+            [:span "Blog"]]
            (om/build auth-link app)]])))))

 (defn invite [app owner]


STORM-1750: Formatting

STORM-1750: Formatting

--- storm-core/src/clj/org/apache/storm/daemon/executor.clj
+++ storm-core/src/clj/org/apache/storm/daemon/executor.clj
@@ -206,9 +206,8 @@
                              (uncaughtException [this _ error]
                                (try
                                  ((:report-error <>) error)
-                               (catch Exception e
-                                 (log-error e "Error while reporting error to cluster, proceeding with shutdown")
-                               ))
+                                 (catch Exception e
+                                   (log-error e "Error while reporting error to cluster, proceeding with shutdown")))
                                (if (or
                                     (Utils/exceptionCauseIsInstanceOf InterruptedException error)
                                     (Utils/exceptionCauseIsInstanceOf java.io.InterruptedIOException error))


Removing debugging.

Removing debugging.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -413,7 +413,6 @@

         ;; handle selection perties table
         (when-not new-property-id
-          (println "Clearing devices data.")
           (om/update! devices :data [])
           (om/update! devices :selected nil))

@@ -512,7 +511,6 @@

         ;; handle selection perties table
         (when-not new-device-id
-          (println "Clearing sensors data.")
           (om/update! sensors :data [])
           (om/update! sensors :selected nil))


working on comparing ips

working on comparing ips

--- src/trend_compliance/core.clj
+++ src/trend_compliance/core.clj
@@ -21,7 +21,7 @@
   (if (re-matches #"(?i)windows*" (get item :platform)) true false))

 (defn create-final-list
-  "create a list of windows machines with successful ping"
+  "create a list of windows machines with successful ping that fail compliance check"
   [item]
   (let [windows-machines (filter windows? item)
         ping-successful-list (filter ping-successful? windows-machines)]
@@ -35,19 +35,7 @@
     {:ip ip
      :off-scan-status off-scan-status
      :ping ping
-     :platform platform
-     ;; :cp-name cp-name
-     ;; :domain domain
-     ;; :mac-ad mac-ad
-     ;; :prod-name prod-name
-     ;; :os-server os-server
-     ;; :version version
-     ;; :patt-file patt-file
-     ;; :scan-eng scan-eng
-     ;; :prev-pol prev-pol
-     ;; :cp-des cp-des
-     ;; :rem-install rem-install
-     }))
+     :platform platform}))

 (defn parse-line
   "parse each line of a large file"
@@ -59,17 +47,23 @@
 (defn line-to-map
   "take a line from detail and put into map using an atom"
   [line]
-  (let [str-line (str (first line))]
   ;; (reset! state {})
-  (if (= str-line (re-find #"\w{3} \w{3} \d{2} \d{2}:\d{2}:\d{2} \d{4}" str-line))
-    (swap! state assoc :date str-line)
+  (if (= (str (first line)) (re-find #"\w{3} \w{3} \d{2} \d{2}:\d{2}:\d{2} \d{4}" (str (first line))))
+    (swap! state assoc :date (str (first line)))
     (swap! state assoc
       (keyword (re-find #"(?x)\S+" (str (first line))))
-      (re-find #"[^\\\"]+" (str (second line)))))))
+      (re-find #"[^\\\"]+" (str (second line))))))

-;; (defn compare-ip
-;;   "compare the ip held in log to the ips on compliance list"
-;;   [
+(defn compare-ip
+  "compare the ip held in log to the ips on compliance list"
+  [wireless-ip]
+  (if
+  )
+
+(defn get-ip
+  "get the ip from map"
+  [item]
+  (get item :ip))

 (defn read-detail
   "read in a large detail file"
@@ -95,8 +89,11 @@
           wireless (second file-names)
           detail (nth file-names 2)
           wired-list (create-final-list (map create-data-map (read-csv wired)))
-          wireless-list (create-final-list (map create-data-map (read-csv wireless)))]
+          wireless-list (create-final-list (map create-data-map (read-csv wireless)))
+          wired-ip-list (map get-ip wired-list)
+          compare-list (compare-ip wired-ip-list)]
+      (println wired-ip-list)
       (println "=============== Wired List: ===============")
-      (pp/pprint wired-list)
-      (println "\n=============== Wireless List: ===============")
-      (pp/pprint wireless-list)))
+      (pp/pprint compare-list)))
+      ;; (println "\n=============== Wireless List: ===============")
+      ;; (pp/pprint wireless-list)))


Add instructions.

Add instructions.

--- src/tryclojure/views/home.clj
+++ src/tryclojure/views/home.clj
@@ -18,6 +18,20 @@
       [:div#header
        [:h1 title]]
       [:div#container
+       [:div.help "
+         Assign       age is '2'

+         Make object  jimmy is a giraffe

+                      jimmy instrument is 'drum'

+         Make list    band is a list

+         Change list  add jimmy to band

+                      remove jimmy from band

+         Output       write band

+
+
+
+
+       "]
+
        [:div#console.console]]
       (javascript-tag
        (str "mode = '" mode "';"))]]]))


Add release date

Add release date

--- src/video_server/freebase.clj
+++ src/video_server/freebase.clj
@@ -61,10 +61,13 @@
   ([md k lang]
    (first (values md k lang))))

-(defn get-year [md]
+(defn get-released [md]
   (when-let [released (or (values md :/film/film/initial_release_date)
                           (values md :/tv/tv_program/air_date_of_first_episode))]
-     (apply min (map (comp first parse-ints :value) released))))
+     (first (sort (map :value released)))))
+
+(defn get-year [md]
+  (first (parse-ints (get-released md))))

 (defn get-runtimes [md]
   (seq (map (comp :value first :values :/film/film_cut/runtime :property)
@@ -220,6 +223,7 @@
   [md]
   (let [info {:name (get-title md)
               :year (get-year md)
+              :released (get-released md)
               :series (get-series md)
               :subjects (get-subjects md)
               :genres (get-genres md)


Improve tests

Improve tests

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -55,6 +55,15 @@
                           [> :c "a"]
                           [<= :c "z"]])
                   )))
+  (println (select :foo
+                   (columns [(-> "asd"
+                                 distinct*
+                                 (as "bsd"))]
+
+                            )))
+  ;; "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo LIMIT :limit;";
+;; select().distinct().column("longName").as("a").ttl("longName").as("ttla").from("foo").limit(bindMarker("limit"));
+
   )

 ;;
@@ -72,8 +81,6 @@
 ;; select().writeTime("a").ttl("a").from("foo").allowFiltering();

-;; "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo LIMIT :limit;";
-;; select().distinct().column("longName").as("a").ttl("longName").as("ttla").from("foo").limit(bindMarker("limit"));

 ;; "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo WHERE k IN () LIMIT :limit;";
 ;; select().distinct().column("longName").as("a").ttl("longName").as("ttla").from("foo").where(in("k")).limit(bindMarker("limit"));


554 agents

554 agents

--- Clojure/cp/src/cp/threads.clj
+++ Clojure/cp/src/cp/threads.clj
@@ -407,6 +407,112 @@

 (comment
 	VARS:
+		def - define vars
+		defn- - private function
+
+	local thread bound
+	can be made to pass thread bounds in certain cases (futures, pmap, etc)
+	root scoped. do not treat as var in c#
+	rebinding a def in a function rebinds it at the root.
+	)
+
+(def ^:private everything 42)
+(def ^{:private true} everything 42)
+
+(def a
+	"a sample value"
+	5)
+
+(meta #'a)
+
+(def ^{:doc "metadata about this object"} a 5)
+(alter-meta! #'a assoc :doc "modified")
+
+(def ^:const everything 42)
+
+(def ^:const max-value 255)
+
+(defn valid-value [v]
+	(<= v max-value))
+
+(def max-value 500)
+
+(let [a 1
+	  b 2]
+	  (println (+ a b))
+	  (let [b 3
+	  	    + -]
+  	    	(println (+ a b)))
+	  (println (+ a b)))
+
+(def ^:dynamic *max-value* 255)
+
+(defn valid-value? [v]
+	(<= v *max-value*))
+
+(binding [*max-value* 500]
+	(valid-value? 299))
+
+(def ^:dynamic *var* :root)
+
+(defn get-*var* [] *var*)
+
+(binding [*var* :a]
+	(binding [*var* :b]
+		(binding [*var* :c]
+			(get-*var*))))
+
+(defn http-get [url-string]
+	(let [conn (-> url-string java.net.URL. .openConnection)
+		  response-code (.getResponseCode conn)]
+		  (if (== 404 response-code)
+		  	[response-code]
+		  	[response-code (-> conn .getInputStream slurp)])))
+
+(def ^:dynamic *response-code* nil)
+
+(defn http-get [url-string]
+	(let [conn (-> url-string java.net.URL. .openConnection)
+		  response-code (.getResponseCode conn)]
+		  (when (thread-bound? #'*response-code*)
+		  	(set! *response-code* response-code))
+		  (when (not= 404 response-code)
+		  	(-> conn .getInputStream slurp))))
+
+(http-get "http://google.com/")
+(binding [*response-code* nil]
+	(let [content (http-get "http://google.com/badurl")]
+		(println "Response Code was:" *response-code*)))
+
+(binding [*max-value* 500]
+	(println (valid-value? 299))
+	@(future (valid-value? 299)))
+
+;defs are root level objects !!!
+
+(def x 80)
+
+(defn never-do-this []
+	(def x 123)
+	(def y 456)
+	(def x (+ x y))
+	x)
+
+(defn rather? []
+	(let [x 123
+		  y 456]
+		  (+ x y)))
+
+(def x 0)
+
+(alter-var-root #'x inc)
+
+(def j)
+(declare complex-helper-fn other-helper-fn)
+
+(comment
+	AGENTS:
+		uncoordinated, asynchronous

 	)

@@ -434,3 +540,4 @@

+


(maint) Restructure tests to avoid timing out

Restructures tests so they don't attempt to deref a promise that already
failed to deref. This should avoid some scenarios where tests get
completely stuck.

--- test/integration/puppetlabs/pcp/broker/controllers_test.clj
+++ test/integration/puppetlabs/pcp/broker/controllers_test.clj
@@ -68,15 +68,17 @@
                         (websockets-client/send! ws (message/encode agent-request)))
                       (deliver response2 (message/decode text))))]
       (with-app-with-config app (conj broker-services server/mock-server) broker-config
-        (is (deref response1 3000 nil))
-        (is (= "http://puppetlabs.com/inventory_response" (:message_type @response1)))
-        (is (= (:id inventory-request) (:in_reply_to @response1)))
-        (is (= [] (get-in @response1 [:data :uris])))
-
-        (is (deref response2 3000 nil))
-        (is (= "http://puppetlabs.com/error_message" (:message_type @response2)))
-        (is (= (:id agent-request) (:in_reply_to @response2)))
-        (is (= "Not connected." (:data @response2)))))))
+        (let [answer1 (deref response1 3000 nil)]
+          (is answer1)
+          (is (= "http://puppetlabs.com/inventory_response" (:message_type answer1)))
+          (is (= (:id inventory-request) (:in_reply_to answer1)))
+          (is (= [] (get-in answer1 [:data :uris]))))
+
+        (let [answer2 (deref response2 3000 nil)]
+          (is answer2)
+          (is (= "http://puppetlabs.com/error_message" (:message_type answer2)))
+          (is (= (:id agent-request) (:in_reply_to answer2)))
+          (is (= "Not connected." (:data answer2))))))))

 (deftest controller-agent-connected-test
   (let [inventory-response (promise)
@@ -98,10 +100,11 @@
         (server/wait-for-inbound-connection (get-context app :MockServer))
         (with-open [client (client/connect :certname agent-cert)]
           ;; Verify we get an inventory including the client
-          (is (deref inventory-response 3000 nil))
-          (is (= "http://puppetlabs.com/inventory_response" (:message_type @inventory-response)))
-          (is (= (:id inventory-request) (:in_reply_to @inventory-response)))
-          (is (= [agent-uri] (get-in @inventory-response [:data :uris])))
+          (let [inventory-answer (deref inventory-response 3000 nil)]
+            (is inventory-answer)
+            (is (= "http://puppetlabs.com/inventory_response" (:message_type inventory-answer)))
+            (is (= (:id inventory-request) (:in_reply_to inventory-answer)))
+            (is (= [agent-uri] (get-in inventory-answer [:data :uris]))))

           (let [response (client/recv! client)
                 target (:target response)
@@ -115,8 +118,9 @@

             ;; Verify message from client reaches controller
             (client/send! client (assoc agent-request :target sender :sender target))
-            (is (deref agent-response 1000 nil))
-            (is (= "greeting" (:message_type @agent-response)))))))))
+            (let [agent-answer (deref agent-response 1000 nil)]
+              (is agent-answer)
+              (is (= "greeting" (:message_type agent-answer))))))))))

 (def self-request (message/make-message
                     {:message_type "loopy"
@@ -127,10 +131,11 @@
     (with-redefs [server/on-connect (fn [_ ws] (websockets-client/send! ws (message/encode self-request)))
                   server/on-text (fn [_ ws text] (deliver response (message/decode text)))]
       (with-app-with-config app (conj broker-services server/mock-server) broker-config
-        (is (deref response 3000 nil))
-        (is (= "http://puppetlabs.com/error_message" (:message_type @response)))
-        (is (= (:id self-request) (:in_reply_to @response)))
-        (is (= "Message not authorized." (:data @response)))))))
+        (let [answer (deref response 3000 nil)]
+          (is answer)
+          (is (= "http://puppetlabs.com/error_message" (:message_type answer)))
+          (is (= (:id self-request) (:in_reply_to answer)))
+          (is (= "Message not authorized." (:data answer))))))))

 (def spoof-sender-request (message/make-message
                             {:message_type "greeting"
@@ -142,10 +147,11 @@
     (with-redefs [server/on-connect (fn [_ ws] (websockets-client/send! ws (message/encode spoof-sender-request)))
                   server/on-text (fn [_ ws text] (deliver response (message/decode text)))]
       (with-app-with-config app (conj broker-services server/mock-server) broker-config
-        (is (deref response 3000 nil))
-        (is (= "http://puppetlabs.com/error_message" (:message_type @response)))
-        (is (= (:id spoof-sender-request) (:in_reply_to @response)))
-        (is (= "Message not authenticated." (:data @response)))))))
+        (let [answer (deref response 3000 nil)]
+          (is answer)
+          (is (= "http://puppetlabs.com/error_message" (:message_type answer)))
+          (is (= (:id spoof-sender-request) (:in_reply_to answer)))
+          (is (= "Message not authenticated." (:data answer))))))))

 (deftest multiple-controllers-test
   (let [responses {:mock-server-1 [(promise) (promise)]
@@ -165,16 +171,19 @@
                                                                 "wss://localhost:58144/server"
                                                                 "wss://localhost:58145/server"])
         (doseq [server [:mock-server-1 :mock-server-2 :mock-server-3]]
-          (let [[response1 response2] (get responses server)]
-            (is (deref response1 3000 nil))
-            (is (= "http://puppetlabs.com/inventory_response" (:message_type @response1)))
-            (is (= (:id inventory-request) (:in_reply_to @response1)))
-            (is (= [] (get-in @response1 [:data :uris])))
-
-            (is (deref response2 3000 nil))
-            (is (= "http://puppetlabs.com/error_message" (:message_type @response2)))
-            (is (= (:id agent-request) (:in_reply_to @response2)))
-            (is (= "Not connected." (:data @response2)))))))))
+          (testing (str "connected to " server ", inventory response received, and agent unreachable")
+            (let [[response1 response2] (get responses server)]
+              (let [answer (deref response1 3000 nil)]
+                (is answer)
+                (is (= "http://puppetlabs.com/inventory_response" (:message_type answer)))
+                (is (= (:id inventory-request) (:in_reply_to answer)))
+                (is (= [] (get-in answer [:data :uris]))))
+
+              (let [answer (deref response2 3000 nil)]
+                (is answer)
+                (is (= "http://puppetlabs.com/error_message" (:message_type answer)))
+                (is (= (:id agent-request) (:in_reply_to answer)))
+                (is (= "Not connected." (:data answer)))))))))))

 (def inventory-subscribe
   (client/make-message
@@ -193,9 +202,10 @@
                         "http://puppetlabs.com/inventory_response" (deliver inventory-response msg)
                         "http://puppetlabs.com/inventory_update" (deliver @inventory-update msg))))]
       (with-app-with-config app (conj broker-services server/mock-server) broker-config
-        (is (deref inventory-response 3000 nil))
-        (is (= (:id inventory-subscribe) (:in_reply_to @inventory-response)))
-        (is (= [] (get-in @inventory-response [:data :uris])))
+        (let [answer (deref inventory-response 3000 nil)]
+          (is answer)
+          (is (= (:id inventory-subscribe) (:in_reply_to answer)))
+          (is (= [] (get-in answer [:data :uris]))))

         (with-open [client (client/connect :certname agent-cert)]
           (let [update (deref @inventory-update 3000 nil)]
@@ -251,9 +261,10 @@
           (with-open [client (client/connect :certname agent-cert)]
             (while (empty? (:inventory @(:database broker)))
               (Thread/sleep 100))
-            (is (deref inventory-response 3000 nil))
-            @first-update-sent?
-            (is (= (:id inventory-subscribe) (:in_reply_to @inventory-response)))
+            (let [answer (deref inventory-response 3000 nil)]
+              (is answer)
+              (is (= (:id inventory-subscribe) (:in_reply_to answer))))
+            (is (deref first-update-sent? 3000 nil))
             ;; Disconnect the mock server
             (doseq [ws @(:inventory (get-context app :MockServer))]
               (websockets-client/close! ws))


AP2 appears to work, at least bottom-up

AP2 appears to work, at least bottom-up

--- src/angelic/search/action_set/asplan2.clj
+++ src/angelic/search/action_set/asplan2.clj
@@ -51,134 +51,82 @@
       (get-in [sas/goal-var-name sas/goal-false-val sas/goal-true-val])
       util/safe-singleton))

-(defn target-var [v] [:target v])
-(defn possible-parent-var [p c]  [:parent? p c])
-(defn possible-actions-var [v]  [:actions v])
+(defn target-var [v] [:target v]) ; a value for v, :wait if no target.
+(defn possible-children-var [v]  [:children v]) ; a set of child vars
+(defn possible-actions-var [v]  [:actions v]) ; a set of actions, :wait if no target.

 (defn expand-initial-state
   "Expand the initial state with lots more stuff.  Each var can be free, OR
    have a child (in which case it must eventually be used to fire an active action on
    that var), AND in such a case, it can also have an active action to help achieve that val.
    (which changes only that var)."
-  [init child-var-map]
-  (let [vars (state/list-vars init)]
-    (state/set-vars init
+  [init child-var-map goal-action]
+  (let [vars (keys child-var-map)]
+    (into {}
       (concat
-       (for [var vars] [(target-var v) nil])
-       (for [[p cs] child-var-map, c cs] [(possible-parent-var p c) true])
-       [[(target-var sas/goal-var-name) sas/goal-true-val]]))))
-
-
-
-
-(defn action-effect-var [a] (util/safe-singleton (keys (:precond-map a))))
-
-
-
-
-
-(defn make-add-action-action [{:keys [name precond-map effect-map reward] :as factored-primitive}]
-  (util/sref-set! *add-count* (inc (util/sref-get *add-count*)))
-  (let [[evar eval] (util/safe-singleton (seq effect-map))]
-    (env-util/make-factored-primitive
-     [::AddAction name]
-     {(action-var evar) nil, evar (precond-map evar)}
-     {(action-var evar) factored-primitive}
-     reward)))
-
-(defn make-set-parent-var-action [p-var c-var]
-  (env-util/make-factored-primitive
-   [::SetParent p-var c-var]
-   {(free-var p-var) true}
-   {(free-var p-var) false (parent-var p-var c-var) true}
+       (for [v vars] [v (state/get-var init v)])
+       (for [v vars] [(target-var v) :wait])
+       (for [v vars] [(possible-children-var v) (child-var-map v)])
+       (for [v vars] [(possible-actions-var v) :wait])
+       [[(target-var sas/goal-var-name) sas/goal-true-val]]
+       [[(possible-actions-var sas/goal-var-name) #{goal-action}]]))))
+
+(defn action-effect-var [a] (util/safe-singleton (keys (:effect-map a))))
+
+
+
+
+(defn make-assign-actions-action [v actions]
+  (assert (set? actions))
+  (env-util/make-factored-primitive
+   [::AssignActions v actions]
+   {}
+   {(possible-actions-var v) actions}
    0))

-
-(defn make-fire-action
-  "Simple version of greedy-fire, used for exhaustive action list. (No add-parent)."
-  [{:keys [name precond-map effect-map reward] :as factored-primitive}]
-  (let [effect-var (key (util/safe-singleton (seq effect-map)))
-        precond-vars (keys (dissoc precond-map effect-var))]
-    (env-util/make-factored-primitive
-     [::Fire name]
-     (into precond-map
-           (concat [[(action-var effect-var) factored-primitive]]
-                   (for [v precond-vars] [(parent-var v effect-var) true])
-                   (for [v precond-vars] [(action-var v) :frozen])))
-     (into effect-map
-           (concat [[(action-var effect-var) nil]]
-                   (for [v precond-vars] [(free-var v)              true])
-                   (for [v precond-vars] [(parent-var v effect-var) false])
-                   (for [v precond-vars] [(action-var v) nil])))
-     0)))
-
-
-;; TODO: should fail if I own parent, it has right value, but an action. (right now, we assert)...
-;; Try to make an action that greedily fires the action scheduled on effect-var,
-;; effectively representing a composition of set-parent and fire-action actions.
-;; Note that this avoids some (unnecessary) branching on children of parent vars.
-;; Assumes this will always be called on a "source", and asserts correspondingly.
-(defn make-greedy-fire-action [s effect-var]
-  (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
-        (->> effect-var action-var (state/get-var s))
-        precond-vars (keys (dissoc precond-map effect-var))
-        [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)]
-    (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars))
-#_    (util/assert-is (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars)
-                    "%s" [name precond-map effect-map s])
-    (env-util/make-factored-primitive
-     [::Fire name]
-     (into precond-map
-           (concat [[(action-var effect-var) factored-primitive]]
-                   (for [v free-pv]   [(free-var v)              true])
-                   (for [v unfree-pv] [(parent-var v effect-var) true])
-                   (for [v precond-vars] [(action-var v) (state/get-var s (action-var v))])))
-     (into effect-map
-           (concat [[(action-var effect-var) nil]]
-                   (for [v unfree-pv] [(free-var v)              true])
-                   (for [v unfree-pv] [(parent-var v effect-var) false])
-                   (for [v precond-vars] [(action-var v) nil])))
-     0)))
-
-
-
-(defn make-greedy-fire-action [s firing-seq]
-  (doseq [[a1 a2] (partition 2 1 firing-seq)]
-    (let [v1 (action-effect-var a1)]
-      (assert (= (state/get-var s v1) (state/get-var s (target-var v1)) ((:precond-map a2) v1)))))
-  (assert (env/state-matches-map? s (apply util/merge-agree (map :precond-map firing-seq))))
-  (env-util/make-factored-primitive
-   (vec (cons ::Fire (map :name firing-seq)))
-   (apply util/merge-agree (map :precond-map firing-seq))
-   (into precond-map
-         (concat [[(action-var effect-var) factored-primitive]]
-                 (for [v free-pv]   [(free-var v)              true])
-                 (for [v unfree-pv] [(parent-var v effect-var) true])
-                 (for [v precond-vars] [(action-var v) (state/get-var s (action-var v))])))
-   (into effect-map
-         (concat [[(action-var effect-var) nil]]
-                 (for [v unfree-pv] [(free-var v)              true])
-                 (for [v unfree-pv] [(parent-var v effect-var) false])
-                 (for [v precond-vars] [(action-var v) nil])))
-   0)
-
-
-  (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
-        (->> effect-var action-var (state/get-var s))
-        precond-vars (keys (dissoc precond-map effect-var))
-        [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)]
-    (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars))
-#_    (util/assert-is (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars)
-                    "%s" [name precond-map effect-map s])
-))
-
-
-(defn make-fire-action-type [s edge-rule effect-var]
-  (doto (case edge-rule
-          :naive (make-fire-action (->> effect-var action-var (state/get-var s)))
-          :greedy (make-greedy-fire-action s effect-var)
-          (:sloppy :extra-sloppy) (make-sloppy-fire-action s effect-var))
-     #_ (-> (env/applicable? s) assert)))
+(defn make-assign-children-action [p children]
+  (assert (set? children))
+  (env-util/make-factored-primitive
+   [::AssignChildren p children]
+   {}
+   {(possible-children-var p) children}
+   0))
+
+(defn make-commitment-action [p c cur-val dst-val wanting-actions possible-actions-fn]
+  (assert (not (= cur-val dst-val)))
+  (assert (set? wanting-actions))
+  (env-util/make-factored-primitive
+   [::Commit p c dst-val wanting-actions]
+   {}
+   {(possible-children-var p) #{c}
+    (possible-actions-var c) wanting-actions
+    (target-var p) dst-val
+    (possible-actions-var p) (possible-actions-fn p cur-val dst-val)}
+   0))
+
+(defn make-greedy-fire-action [s a effect-var cvm possible-actions-fn]
+  (doseq [[pvar pval] (dissoc (:precond-map a) effect-var)]
+    (assert (= (state/get-var s pvar) pval))
+    (assert (= (state/get-var s (possible-actions-var pvar)) :wait)))
+  (env-util/make-factored-primitive
+   [::Fire a]
+   {}
+   (into (:effect-map a)
+         (cons
+          [(possible-actions-var effect-var)
+           (let [cur-val (get (:effect-map a) effect-var)
+                 dst-val (state/get-var s (target-var effect-var))]
+             (assert (not (= dst-val :wait)))
+             (if (= cur-val dst-val) :wait (possible-actions-fn effect-var cur-val dst-val)))]
+          (apply concat
+                 (for [[pvar pval] (dissoc (:precond-map a) effect-var)]
+                   [[(possible-children-var pvar) (cvm pvar)]
+                    [(possible-actions-var pvar) :wait]
+                    [(target-var pvar) :wait]]))))
+   (:reward a)))
+
+
+

@@ -202,178 +150,75 @@
           :when (and (= s cur-val) (not (contains? (backward-sets t) s)))]
       t)))

-
-(defn allowed-action? [s a effect-var]
-  (assert (= effect-var (util/safe-singleton (keys (:effect-map a)))))
-  (every?
-   (fn [v]
-     (when (state/get-var s (possible-parent-var v effect-var))
-       (assert (not (state/get-var s (target-var v))))
-       true))
-   (keys (:precond-map a))))
-
-(defn greedy-action? [s a] (state/state-matches-map? s (:precond-map a)))
-
-
-;; if a var is actually assigned and has a target and its value is right, ...
-(defn fire-sequences [s v])
-
-
-
-
-
-(defn bottom-up-actions [s v cvm dtgs acyclic-succ-fn]
-  (let [cur-val (state/get-var s v)
-        dst-val (state/get-var s (target-var v))
-        [greedy-actions ungreedy-actions] (->> (acyclic-succ-fn v cur-val dst-val)
-                                               (map (dtgs v cur-val))
-                                               (apply concat)
-                                               (filter #(allowed-action? s % v) )
-                                               (util/separate greedy-action?))]
-    (assert dst-val)
-    (assert (not (= cur-val dst-val)))
+(defn make-possible-actions-fn [dtgs]
+  (let [simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
+        acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
+    (fn [var cur-val dst-val]
+      (for [nxt-val (acyclic-succ-fn var cur-val dst-val),
+            a       (get-in dtgs [var cur-val nxt-val])]
+        a))))
+
+
+
+
+(defn greedy-action? [s a effect-var]
+  (assert (= effect-var (action-effect-var a)))
+  (and (state/state-matches-map? s (:precond-map a))
+       (every? #(contains? (state/get-var s (possible-children-var %)) effect-var)
+               (keys (dissoc (:precond-map a) effect-var)))))
+
+
+
+
+
+;; return a list of actions, or nil if no greedy possibilities.
+(defn greedy-actions [s v cvm possible-actions-fn]
+  (let [actions (state/get-var s (possible-actions-var v))
+        [greedy not-greedy]    (when-not (= :wait actions) (util/separate #(greedy-action? s % v) actions))]
+    (when (seq greedy)
+      (concat
+       (when (seq not-greedy) [(make-assign-actions-action v (set not-greedy))])
+       (for [a greedy] (make-greedy-fire-action s a v cvm possible-actions-fn))))))
+
+;; TODO: treat happy same as concerned?
+;; Split based on:
+;;  split out actions that don't care about p or want current value of p.
+;;  no reservation of p (if remaining vals)
+;;  reserve p, split on target-val for p.
+(defn refinement-actions [s p c possible-actions-fn]
+  (let [actions (state/get-var s (possible-actions-var c))
+        children (state/get-var s (possible-children-var p))
+        cur-val  (state/get-var s p)
+        [concerned indifferent] (util/separate #(contains? (:precond-map %) p) actions)
+        [happy unhappy]         (util/separate #(= (get (:precond-map %) p) cur-val) concerned)
+        lazy-set                (set (concat happy indifferent))]
+    (assert (not-any? #(greedy-action? s % c) actions))
+    (assert (seq unhappy))
+    (assert (contains? children c))
+    (assert (= :wait (state/get-var s (target-var p))))
     (concat
-     (intentional-actions s ungreedy-actions)
-     (for [a greedy-actions, fs (fire-sequences s a)]
-       (make-greedy-fire-action s fs)))))
-
-
-
-
-
-;; TODO: generalize to modes other than greedy.
-(defn var-ordering-edges
-  "Construct a graph on the state variables, where an edge from s --> t means
-   'something must happen at s for the action at t to go away', more or less.
-
-   Specifically, we have the following kinds of edges:
-    (1)                  If (= (action-var v) :frozen), child(v)!=nil, child(v) -->  v
-    (2)(a) naive:        If (action-var c) has precondition on p, (not owned or not frozen) and not reserved elsewhere, p --> c
-    (2)(b) greedy etc.:  If (action-var c) has precondition on p, value mismatch and not reserved elsewhere, p --> c
-    (3)(a) naive+greedy: If (action-var c) has precondition on p, reserved by o!=c, o --> c
-    (3)(b) sloppy:       If (action-var c) has precondition on p, value mismatch or action on p and reserved by o!=c, o --> c
-    (3)(c) extra-sloppy: If (action-var c) has precondition on p, value mismatch and reserved by o!=c, o --> c"
-  [s child-map rule]
-  (apply concat
-         (for [v (keys child-map)]
-           (let [a (state/get-var s (action-var v))]
-             (cond
-               (nil? a)      nil
-               (= :frozen a) (when-let [c (current-child s child-map v)] [[c v]])
-               :else         (remove nil?
-                               (for [[p pval] (-> a (util/safe-get :precond-map) (dissoc v))]
-                                (let [right-val? (= (state/get-var s p) pval)
-                                      p-child    (current-child s child-map p)
-                                      unavail?   (not (or (= p-child nil) (= p-child v)))]
-                                  (case rule
-                                    :naive  (cond unavail?         [p-child v]
-                                                  (or (not (= p-child v)) (not (= (state/get-var s (action-var p)) :frozen))) [p v])
-                                    :greedy (cond unavail?         [p-child v]
-                                                  (not right-val?)
-                                                  #_(when-not (some #(let [c (current-child s child-map %)]
-                                                                     (not (or (= p-child nil) (= p-child v))))
-                                                                  (keys (dissoc (:precond-map a) v)))
-                                                    [p v])  ;; TODO: put back?
-
-                                                    [p v])
-                                    :sloppy (cond (and unavail? (or (not right-val?) (when-let [a (state/get-var s (action-var p))] (not (= a :frozen)))))         [p-child v]
-                                                  (and (not unavail?) (not right-val?)) [p v])
-                                    :extra-sloppy
-                                            (cond (and unavail? (not right-val?)) [p-child v]
-                                                  (and (not unavail?) (not right-val?)) [p v]))))))))))
-
-
-
-
-(defn source-vars
-  "Take the graph from var-ordering-edges, and return the sources in the same component
-   as the goal variable, which are ripe for action.  Returns nil if there are any cycles
-   in the graph, since this indicates a deadlock (at least some actions cannot fire)."
-  [s child-map check-deadlock? check-components? edge-rule]
-;  (println (var-ordering-edges s child-map rule))
-  (let [edges (doall (var-ordering-edges s child-map edge-rule))]
-    (when (or (not check-deadlock?) (graphs/dag? edges))
-      (let [sources (clojure.set/difference (set (cons sas/goal-var-name (map first edges))) (set (map second edges)))
-            goal-component-sources
-            (if check-components?
-              (clojure.set/intersection
-               sources
-               (graphs/ancestor-set (cons [sas/goal-var-name sas/goal-var-name] edges) [sas/goal-var-name]))
-              sources)]
-        (when-not (= (count sources) (count goal-component-sources)) (println "Warning: multiple components..."))
-        (when check-deadlock? (assert (seq goal-component-sources)))
-        goal-component-sources))))
-
-(defn source-var-type [s child-map v]
-  (let [a (state/get-var s (action-var v))]
-    (cond (= a :frozen)  :top-down-activate
-          a              :fire
-
-          ;; no action
-          (not (state/get-var s (free-var v))) :bottom-up-action
-          (some (fn [c] (when-let [ca (state/get-var s (action-var c))]
-                          (contains? (:precond-map ca) v)))
-                (child-map v))
-                         :bottom-up-activate
-          :els           :top-down-action)))
-
-;; TODO: dynamic bottom-up pruning.
- ; i.e., exists precondition of some current action, NOT currently achieved,
- ; that has every child of a parent-link in its ancestor-set.
-; Or, more simply, variables should "die off".
-;; TODO: generalize.  This is just special case for most logistics.
-(defn uses-dead-vars? [s ancestor-map child-map extra-edges]
-;  false #_
-  (let [gpm      (:precond-map (state/get-var s (action-var sas/goal-var-name)))
-        live-set (apply clojure.set/union #{sas/goal-var-name}
-                        (for [pv (remove #{sas/goal-var-name} (keys gpm))
-                              :when (not (= (state/get-var s pv) (gpm pv)))]
-                          (ancestor-map pv)))]
-    (not-every? live-set
-                (concat (map second extra-edges)
-                        (for [p (keys child-map)
-                              :let [a (state/get-var s (action-var p))]
-                              :when (and a (not (= a :frozen)))]
-                          p)
-                        (for [[p cs] child-map, c cs
-                              :when (state/get-var s (parent-var p c))]
-                          c)))))
-
-
-(defn activation-actions  "Return a list of all activation actions for var v"
-  [child-map v]
-  (for [c (child-map v)]
-    (make-set-parent-var-action v c)))
-
-(defn add-actions [s v dtgs]
-  (cons (make-freeze-var-action v)
-        (for [as (vals (get-in dtgs [v (state/get-var s v)])), a as]
-          (make-add-action-action a))))
-
-(defn add-directed-actions [s v dtgs cvm acyclic-succ-fn]
-  (let [c-val (state/get-var s v)
-        dtg   (get-in dtgs [v c-val])
-        child (current-child s cvm v)
-        d-val (-> (state/get-var s (action-var child)) :precond-map (get v))]
-    ;;    (when greedy? #_ (util/assert-is (not (= c-val d-val)) "%s" (def *s* s)))
-    (if d-val
-      (if (= c-val d-val)
-        [(make-freeze-var-action v)]
-        (for [n-val (acyclic-succ-fn v c-val d-val), a (dtg n-val)]
-          (make-add-action-action a)))
-      ;; This should only arise in cyclic domains -- TODO: remove?
-      (add-actions s v dtgs))))
-
-;   (or (deadlocked? s child-map [[v c]]))
+     (when-not (empty? lazy-set)
+       [(make-assign-actions-action c lazy-set)])
+     (when (> (count children) 1)
+       [(make-assign-children-action p (disj children c))])
+     (for [[dst-val wanting-actions] (group-by #((:precond-map %) p) unhappy)]
+       (make-commitment-action p c cur-val dst-val (set wanting-actions) possible-actions-fn)))))
+
+(defn var-precondition-choices [s v]
+  (let [actions (state/get-var s (possible-actions-var v))]
+    (when-not (= actions :wait)
+      (filter
+       (fn [p] (and (= :wait (state/get-var s (target-var p)))
+                    (contains? (state/get-var s (possible-children-var p)) v)
+                    (some #(when-let [v (get (:precond-map %) p)] (not (= (state/get-var s p) v))) actions)))
+       (distinct (apply concat (map (comp keys :precond-map) actions)))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions fn, actual env ;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defrecord ASPlanEnv [base-sas-env init actions actions-fn g-map
-                    ; Following stuff is used by hierarchy.
-                      causal-graph dtgs ancestor-var-map child-var-map topological-sort-indices acyclic-succ-fn]
+(defrecord ASPlanEnv [base-sas-env init actions-fn g-map]
   env/Env
     (initial-state [e] init)
     (actions-fn    [e] actions-fn)
@@ -381,8 +226,7 @@
   env/FactoredEnv
     (goal-map      [e] g-map))

-;; TODO: add assertions on precond var = effect var
-;; Recall: greedy helps the most when, e.g., lots of passengers and not much room.
+
 (defn make-asplan-env
   "Make an actino-set planning environment.  Switches are:
     check-deadlock?: check for cycles in precedence graph above and beyond lack of sources
@@ -392,71 +236,36 @@
        Greedy means we forget about reserving preconditions when free and we can fire right now (less branching).
        Sloppy means we ignore if preconditions are free, but require no action on them.
        Extra-sloppy means anything goes -- if you can execute ignoring commitments, go for it."
-  ([sas-problem & {:keys [directed? greedy? deadlock? dead-vars? components?] :as m
-                   :or   {directed? true greedy? true deadlock? true dead-vars? true components? false}}]
-     (assert (every? #{:directed? :greedy? :deadlock? :dead-vars? :components?} (keys m)))
-     (let [edge-rule     (if greedy? :greedy :naive)
-           causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
+  ([sas-problem]
+     (let [causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
            vars          (graphs/ancestor-set causal-graph [sas/goal-var-name])
            causal-graph  (filter (fn [[v1 v2]] (and (vars v1) (vars v2))) causal-graph)
            tsi           (graphs/df-topological-sort-indices causal-graph) ;; TODO: doesn't seem to matter...
-           av-map        (into {} (for [v vars] [v (graphs/ancestor-set causal-graph [v])]))
-           child-var-map (assoc (util/map-vals #(map second %) (group-by first causal-graph))
-                           sas/goal-var-name [])
-                                        ;        vars          (keys (:vars sas-problem))
+           child-var-map (assoc (util/map-vals #(set (map second %)) (group-by first causal-graph))
+                           sas/goal-var-name #{})
            dtgs          (sas-analysis/domain-transition-graphs sas-problem)
-           simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
-           acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
+           possible-actions-fn (make-possible-actions-fn dtgs)]
 ;       (assert (graphs/dag? causal-graph))
        (assert (sas-analysis/unary? sas-problem))
+;       (println child-var-map)

        (ASPlanEnv.
         sas-problem
         (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
-        (concat
-         (for [v vars] (make-freeze-var-action v))
-         (for [a (:actions sas-problem)] (make-add-action-action a))
-         (for [[p cs] child-var-map, c cs] (make-set-parent-var-action p c))
-         (for [a (:actions sas-problem)] (make-fire-action a)))

         (fn asplan-actions [s]
-          (when-let [sources (and (or (not dead-vars?) (not (uses-dead-vars? s av-map child-var-map [])))
-                                  (seq (source-vars s child-var-map deadlock? components? edge-rule)))]
-            (let [sources-by-type (group-by #(source-var-type s child-var-map %) sources)]
-;;              (println sources-by-type)
-              (util/cond-let [sources]
-                (seq (sources-by-type :fire))
-                [(make-fire-action-type s  edge-rule (first sources))]
-
-                (seq (sources-by-type :bottom-up-action))
-                (if directed?
-                  (add-directed-actions s (apply min-key tsi sources) dtgs child-var-map acyclic-succ-fn)
-                  (add-actions s (apply min-key tsi sources) dtgs))
-
-                (seq (sources-by-type :bottom-up-activate))
-                (activation-actions child-var-map (apply max-key tsi sources)) ;; TODO: smarter sort!
-
-                (seq (sources-by-type :top-down-activate))
-                (do (println "I!") (activation-actions child-var-map (first sources)))
-
-                (seq (sources-by-type :top-down-action))
-                (do (println "A!") (add-actions s (first sources) dtgs))
-
-                :else (assert "Unknown source type!")))))
-        (env/goal-map sas-problem)
-        causal-graph dtgs av-map child-var-map tsi acyclic-succ-fn))))
-
-(comment
-  (try [(make-fire-action-type s  edge-rule (first sources))] ;; TODO: rempve!
-                              (catch AssertionError e nil)))
-
-(defn make-naive-asplan-env
-  "Replace the actions-fn in asplan-env with one that generates all legal actions,
-   with no partitioning or pruning."
-  [sas-problem]
-  (let [e (make-asplan-env sas-problem)]
-    (assoc e :actions-fn (sas/make-simple-successor-generator (keys (:init e)) (:actions e)))))
-
+;          (println "\n"(:act-seq (meta s)))
+          (identity #_ util/prln (or (some #(greedy-actions s % child-var-map possible-actions-fn) vars)
+               (let [choices (for [v vars, p (var-precondition-choices s v)]
+                               (refinement-actions s p v possible-actions-fn))]
+;                 (when (empty? choices) (clojure.inspector/inspect-tree (state/as-map s)) #_ (assert nil))
+;                 (println (map count choices))
+                 (assert (not-any? empty? choices))
+                 (if (seq choices)
+                   (apply min-key count choices)
+                   #_ (println "is a dead end"))))))
+        (env/goal-map sas-problem)))))
+;; TODO: assert no top-down.

 (defn asplan-solution-name [sol]
   (map second (filter #(= (first %) ::Fire) sol)))
@@ -473,16 +282,10 @@

-;; (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.search.action-set.asplan  'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'angelic.util 'angelic.sas.hm-heuristic)
-
-;; (let [e (make-random-infinite-taxi-sas2 4 4 4 2)] (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e)))))))
-
-;; (let [i 25] (let [e (make-random-infinite-taxi-sas2 3 3 3 i) ae (make-asplan-env e)]  (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted (fn [] (a*-search e (h-max (:actions e))))))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search ae))))) (println (time (run-counted #(asplan-solution-pair-name (a*-search ae (h-max (:actions ae))))))) (println (time (run-counted #(asplan-solution-pair-name (a*-search ae (let [h (h-max (:actions ae))] (fn [s] (- (h s) (unrealized-reward s)))))))))))
-
-; (let [e (force (nth ipc2-logistics 3)) ] #_ (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e)))))))
-
-
- ; (doseq [[alg sp]  [[make-asplan-env asplan-solution-pair-name] [angelic.search.action-set.asplan-broken/make-asplan-env angelic.search.action-set.asplan-broken/asplan-solution-pair-name]] ] (println (time (run-counted #(sp (uniform-cost-search (alg (make-random-infinite-taxi-sas2 3 3 3 3))))))))
-
-; (-> (nth (vals (sas-sample-files 1)) 5) make-sas-problem-from-pddl unarize make-asplan-env interactive-search)
-
+;; (do (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite  'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'angelic.util) (require '[angelic.search.action-set.asplan2 :as ap2]))
+
+;; (let [e (force (nth ipc2-logistics 5)) ]  (println (time (run-counted #(ap2/asplan-solution-pair-name (uniform-cost-search (ap2/make-asplan-env e )))))))
+
+;; (let [e (make-random-independent-taxi-env 3 3 3 false 1) ]  (println (time (run-counted #(ap/asplan-solution-pair-name (uniform-cost-search (ap/make-asplan-env e ))))))  (println (time (run-counted #(ap2/asplan-solution-pair-name (uniform-cost-search (ap2/make-asplan-env e )))))))
+
+;; (let [e (make-random-pairwise-taxi-env 2 2 3 true 1) ]  (println (time (run-counted #(ap/asplan-solution-pair-name (uniform-cost-search (ap/make-asplan-env e ))))))  (println (time (run-counted #(ap2/asplan-solution-pair-name (uniform-cost-search (ap2/make-asplan-env e )))))))


Update apartment file

Update apartment file

--- src/cljs/gampg/learn_gamma/apartment.cljs
+++ src/cljs/gampg/learn_gamma/apartment.cljs
@@ -14,6 +14,13 @@
               [thi.ng.geom.core.vector :as vec])
     (:require-macros [cljs.core.async.macros :as async :refer [go]])
     (:import [goog.net XhrIo]))
+
+
+(defn request-full-screen [canvas hmd]
+  (cond
+    (aget canvas "mozRequestFullScreen")    (.call (aget canvas "mozRequestFullScreen") canvas #js{:vrDisplay hmd})
+    (aget canvas "webkitRequestFullscreen") (.call (aget canvas "webkitRequestFullscreen") canvas #js{:vrDisplay hmd})
+    :else                                   :fail))

 (defn append-buffers [buffer-1 buffer-2]
   (let [cl  (+ (.-byteLength buffer-1)
@@ -139,27 +146,7 @@
        (reduce merge {})
        (assoc root-node :children)))

-(defn fix-webgl-inspector-quirks [capture-first-frame? show? & [height]]
-  (let [inspector-capture-nodes (js/document.querySelectorAll "[title='Capture frame (F12)']")
-        inspector-ui-nodes      (js/document.querySelectorAll "[title='Show full inspector (F11)']")
-        inspector-windows       (js/document.querySelectorAll ".splitter-horizontal")
-        target-capture-node     (aget inspector-capture-nodes 1)
-        synthetic-click         (doto (js/document.createEvent "MouseEvent")
-                                  (.initMouseEvent "click", true, true, js/window, 0, 0, 0, 0, 0, false, false, false, false, 0))]
-    (when (= 3 (.-length inspector-capture-nodes))
-      (.remove (aget inspector-capture-nodes 0))
-      (.remove (aget inspector-ui-nodes 0))
-      (.remove (aget inspector-capture-nodes 2))
-      (.remove (aget inspector-ui-nodes 2))
-      (.remove (.-parentNode (aget inspector-windows 0)))
-      (.remove (.-parentNode (aget inspector-windows 2)))
-      (when capture-first-frame?
-        (.dispatchEvent target-capture-node synthetic-click))
-      (aset js/window "captureNextFrame"
-            (fn [] (.dispatchEvent target-capture-node synthetic-click)))
-      (let [inspector-window (.-parentNode (aget inspector-windows 1))
-            existing-height  (.-clientHeight inspector-window)]
-        (.setAttribute inspector-window "style" (str "height: " height "px;" (when-not show? "display: none;")))))))
+

 (def default-model
   "apartment_3.gltf")
@@ -193,7 +180,8 @@
                     :tick-first-frame?    false
                     :manual-tick?         false
                     :collapse-all?        false
-                    :capture-first-frame? false}
+                    :capture-first-frame? false
+                    :super-mesh?          false}
         initial    (reduce merge {} (map (partial uri-param parsed-uri) (clj->js ks)))
         ;; Use this if you need to do any fn-based changes, e.g. split on a uri param
         special {:skybox-name (when-let [skybox-name (second (uri-param parsed-uri "skybox-name" "sky1.png"))]
@@ -246,7 +234,7 @@
    189 "-"
    190 "."})

-(defn track-key-state [cast! direction suppressed-key-combos event]
+(defn track-key-state [cast! direction suppressed-key-combos app-state event]
   (let [meta?      (when (.-metaKey event) "meta")
         shift?     (when (.-shiftKey event) "shift")
         ctrl?      (when (.-ctrlKey event) "ctrl")
@@ -282,6 +270,11 @@
                                         js/String.fromCharCode
                                         .toLowerCase))]
         (let [key-name (keyword (str human-name "?"))]
+          (when (and (= key-name :t?)
+                     (= direction :down)
+                     app-state)
+            (request-full-screen (get-in @app-state [:webgl :canvas :node])
+                                 (get-in @app-state [:hmds :hmd])))
           (cast! :key-state-changed [{:key-name-kw key-name
                                       :code        (.-which event)
                                       :depressed?  (= direction :down)}]))))))
@@ -591,7 +584,7 @@
      u-point-lighting-color #js[0.8 0.8 0.8]
      u-point-lighting-diffuse-color  #js[0.8 0.8 0.8]
      u-point-lighting-specular-color #js[0.8 0.8 0.8]
-     u-material-shininess            1
+     u-material-shininess            42
      u-use-lighting       true
      u-light-angle        #js [;;-1 0 -1
                                -1.5092036732051048 -3.149999999999983, 1
@@ -755,13 +748,13 @@
         texture-program? (map? material)]
     (if texture-program?
       (do
-        :texture-specular-per-fragment
+        ;;:texture-specular-per-fragment
         :texture-per-fragment-light
         ;;:texture-flat
         )
       (do
         :diffuse-per-fragment-light
-        :diffuse-light
+        ;;:diffuse-light
         ;;:diffuse-flat
         ))))

@@ -783,7 +776,7 @@
                             n))
         render-node     (fn render-node [[node-name node] mv]
                           (let [mv mv ;;(geom/* mv (:matrix node))
-                                ]
+]
                             (doseq [mesh (:meshes node)]
                               (doseq [[index mesh] (map vector (range) (:primitives mesh))]
                                 (let [vertices         (assoc (get-in mesh [:attributes :p]) :id (primitive-id node-name mesh index :p))
@@ -822,7 +815,7 @@
                                                    (get-in state [:debug :collapse-all?])))
                                     ;;(js/console.log "draw-elements " (pr-str program-name))
                                     #_(js/console.log "\tscene-data:" (clj->js (assoc scene-data
-                                                                                {:tag :element-index} indices)))
+                                                                                {:tag :element-index} indices)))
                                     (gd/draw-elements driver (gd/bind driver program
                                                                       (assoc scene-data
                                                                              {:tag :element-index} indices))
@@ -846,16 +839,18 @@
         (.scissor  gl sx sy sw sh)
         (.clear gl (.-DEPTH_BUFFER_BIT gl))
         ;;(.clear gl (bit-or (.-COLOR_BUFFER_BIT gl) (.-DEPTH_BUFFER_BIT gl)))
-        ;;(js/console.log "eye: " (clj->js eye))
+        (js/console.log "eye: " (clj->js eye))
         (doseq [node (:nodes scene)]
           (let [scale (max (js/Math.abs (* rot 2)))]
             ;;(js/console.log "Rendering node: " (clj->js node))
             (render-node [(:name node) node] (-> mv
                                                  (geom/rotate-around-axis [1 0 0] (- (:pitch camera)))
                                                  (geom/rotate-around-axis [0 1 0] (- (:yaw camera)))
-                                                 (geom/translate [(- (:x camera) (get-in eye [:translation :x]))
+                                                 (geom/rotate-around-axis [0 0 1] (- (:roll camera)))
+                                                 (geom/translate [(- (- (:x camera)) (get-in eye [:translation :x]))
                                                                   (- (:y camera))
-                                                                  (- (:z camera) (get-in eye [:translation :z]))])
+                                                                  (- (- (:z camera)) (get-in eye [:translation :z])
+                                                                     )])
                                                  ;;(geom/translate [-3 0 5.5])
                                                  (geom/rotate-around-axis [1 0 0] (* js/Math.PI 1.5))
                                                  ;;(geom/rotate-around-axis [0 0 1] (if (:flip-y? camera) js/Math.PI 0))
@@ -888,12 +883,12 @@
   (let [time-now      (.getTime (js/Date.))
         elapsed       (- time-now (:last-rendered state))
         pos           (when-let [sensor (get-in state [:hmds :pos])]
-                        (.getState sensor))
+                        (.call (aget sensor "getState") sensor))
         ;; TODO: change these to abstract :forward/:backward lookups
         ;; if it's not too expensive
         ;; TODO: Make this configurable at runtime to tweak with the values
         last-hmd-pos  (get-in state [:scene :hmd-pos])
-        hmd-move-factor 10
+        hmd-move-factor 0
         hmd-x         (aget pos "position" "x")
         hmd-y         (aget pos "position" "y")
         hmd-z         (aget pos "position" "z")
@@ -919,8 +914,9 @@
                             slow-factor)
                          hmd-dy)
         camera        (-> (get-in state [:scene :camera])
-                          (assoc :yaw (aget pos "orientation" "y"))
-                          (assoc :pitch (aget pos "orientation" "x")))]
+                          (assoc :yaw   (* 1 js/Math.PI (aget pos "orientation" "y")))
+                          (assoc :pitch (* 1 js/Math.PI (aget pos "orientation" "x")))
+                          (assoc :roll  (* 1 js/Math.PI (aget pos "orientation" "z"))))]
     (if (zero? (:last-rendered state))
       (-> state
           (assoc :last-rendered time-now)
@@ -946,6 +942,9 @@
   [message [{:keys [key-name-kw depressed?]}] state]
   (when-let [capture (and (= key-name-kw :c?) (.-captureNextFrame js/window))]
     (.call capture))
+  (when (= key-name-kw :t?)
+    (request-full-screen (get-in state [:webgl :canvas :node])
+                         (get-in state [:hmds :hmd])))
   (assoc-in state [:keyboard key-name-kw] depressed?))

 (defmethod control-event :mouse-moved
@@ -994,8 +993,8 @@
         key-up-handler           (fn [])
         suppressed-key-combos    #{"meta+A" "meta+D" "meta+Z" "shift+meta+Z" "backspace"
                                    "shift+meta+D" "up" "down" "left" "right" "meta+G"}
-        handle-key-down          (partial track-key-state cast! :down suppressed-key-combos)
-        handle-key-up            (partial track-key-state cast! :up   suppressed-key-combos)
+        handle-key-down          (partial track-key-state cast! :down suppressed-key-combos app-state)
+        handle-key-up            (partial track-key-state cast! :up   suppressed-key-combos nil)
         handle-mouse-move!       #(handle-mouse-move cast! %)
         handle-canvas-mouse-down #(handle-mouse-down cast! %)
         handle-canvas-mouse-up   #(handle-mouse-up   cast! %)
@@ -1191,7 +1190,7 @@

 (defn get-hmds [cb]
   (let [dev-ch      (chan)
-        dev-promise (js/navigator.getVRDevices)
+        dev-promise (.call (aget js/navigator "getVRDevices") js/navigator)
         fov->clj    (fn [fov]
                       {:up    (aget fov "upDegrees")
                        :down  (aget fov "downDegrees")
@@ -1214,19 +1213,19 @@
     (.then dev-promise
            (fn [result]
              (let [devices    (js->clj result)
-                   hmd        (some #(and (= (type %) js/HMDVRDevice)
+                   hmd        (some #(and (= (type %) (aget js/window "HMDVRDevice"))
                                           %) devices)
                    pos-sensor (when hmd
-                                (some #(and (= (type %) js/PositionSensorVRDevice)
-                                            (= (.-hardwareUnitId %)
-                                               (.-hardwareUnitId hmd))
+                                (some #(and (= (type %) (aget js/window "PositionSensorVRDevice"))
+                                            (= (aget % "hardwareUnitId")
+                                               (aget % "hardwareUnitId"))
                                             %) devices))
                    devices    {:hmd hmd
                                :pos pos-sensor}]
                ;; Initialize the sensors, gather basic unchanging data
                ;; (fov, eye translations, etc.)
-               (.resetSensor pos-sensor)
-               (let [left-eye  (.getEyeParameters hmd "left")
+               (.call (aget pos-sensor "resetSensor") pos-sensor)
+               (let [left-eye  (clj->js (.call (aget hmd "getEyeParameters") hmd "left"))
                      left-eye  (-> {}
                                    (assoc :fov (fov->clj (aget left-eye "currentFieldOfView")))
                                    (assoc :max-fov (fov->clj (aget left-eye "maximumFieldOfView")))
@@ -1234,7 +1233,7 @@
                                    (assoc :rec-fov (fov->clj (aget left-eye "recommendedFieldOfView")))
                                    (assoc :translation (dom-point->clj (aget left-eye "eyeTranslation")))
                                    (assoc :render-rect (dom-rect->clj (aget left-eye "renderRect"))))
-                     right-eye (js->clj (.getEyeParameters hmd "right"))
+                     right-eye (js->clj (.call (aget hmd "getEyeParameters") hmd "right"))
                      right-eye (-> {}
                                    (assoc :fov (fov->clj (aget right-eye "currentFieldOfView")))
                                    (assoc :max-fov (fov->clj (aget right-eye "maximumFieldOfView")))
@@ -1328,7 +1327,12 @@
                                           (let [combined-primitives (->> nodes
                                                                          (map (fn [node] [(:name node) node]))
                                                                          (map (partial walk-tree-combining-meshes
-                                                                                #(get-in % [:material :values :diffuse]) 65532 0 []))
+                                                                                (if (:super-mesh? initial-query-map)
+                                                                                (constantly true)
+                                                                                #(get-in % [:material :values :diffuse]))
+                                                                                65532 0 []
+                                                                                ;;
+                                                                                ))
                                                                          (mapcat vals)
                                                                          flatten
                                                                          (sort-by primitive->program-name))
@@ -1349,7 +1353,8 @@
                                                                                :draw-mode 4}
                                                                                tagged-primitive
                                                                                ;; Remove once we support materials
-                                                                                ;;{:material  {:values {:diffuse [0.800000011920929 0.09411760419607162 0.16862799227237701 1]}, :name "material_1"}}
+                                                                                (when (:super-mesh? initial-query-map)
+                                                                                {:material  {:values {:diffuse [0.800000011920929 0.09411760419607162 0.16862799227237701 1]}, :name "material_1"}})
                                                                                )]}]}]
                                                                               (js/console.log "\tnew: " (clj->js new-primitive))
                                                                               new-primitive))
@@ -1370,7 +1375,7 @@
                                                      :controls controls
                                                      :keyboard keyboard}}))]
         (<! (async/timeout 500))
-        (fix-webgl-inspector-quirks true true 250)
+        o(utils/fix-webgl-inspector-quirks true true 250)
         (aset js/window "processedGLTF" (clj->js scene))
         (aset js/window "scene" scene)


Updated v1->v2 converter for temporal params.

--- src/cmr/opendap/ous/query/params/core.clj
+++ src/cmr/opendap/ous/query/params/core.clj
@@ -24,19 +24,19 @@

 (defn v1->v2
   [params]
-  (let [collection-id (or (:collection-id params)
-                          (util/coverage->collection (:coverage params)))
-        subset (:subset params)]
+  (let [subset (:subset params)]
     (-> params
-        (assoc :collection-id collection-id
+        (assoc :collection-id (or (:collection-id params)
+                                  (util/coverage->collection (:coverage params)))
                :granules (util/coverage->granules (:coverage params))
                :variables (:rangesubset params)
                ;; There was never an analog in v1 for exclude-granules, so set
                ;; to false.
                :exclude-granules false
                :bounding-box (when (seq subset)
-                              (util/subset->bounding-box subset)))
-        (dissoc :coverage :rangesubset)
+                              (util/subset->bounding-box subset))
+               :temporal (:timeposition params))
+        (dissoc :coverage :rangesubset :timeposition)
         (v2/map->CollectionParams))))

 (defn parse


Added support for application/json results.


using config as a state

using config as a state

--- src/sormilla/video.clj
+++ src/sormilla/video.clj
@@ -115,18 +115,14 @@
 ;; ============================================================================
 ;;

-(def cancel-ch (atom nil))
-
 (def service (reify system/Service
                (start! [this config]
                  (let [ch (async/chan)]
                    (thread* (video-streaming-task ch))
-                   (reset! cancel-ch ch))
-                 config)
+                   (assoc config :video ch)))
                (stop! [this config]
-                 (when-let [ch @cancel-ch]
-                   (async/close! ch)
-                   (reset! cancel-ch nil))
-                 config)))
+                 (when-let [ch (:video config)]
+                   (async/close! ch))
+                 (dissoc config :video))))

 ; ffmpeg -f h264 -an -i capture.h264 stream.m4v


Home view text.

Home view text.

--- src/dummy_om_app/app/components/home.cljs
+++ src/dummy_om_app/app/components/home.cljs
@@ -6,6 +6,23 @@
             [om.dom                 :as dom :include-macros true])
   (:require-macros [om-utils.core :refer [defcomponent]]))

+(def home-text
+  [{:render-fn dom/div
+    :text      "Welcome to the app!"}
+   {:render-fn dom/div
+    :text      "It doesn't do much yet... but you can read about the technologies I used to build it below."}
+   {:render-fn dom/a
+    :text      "Om (client side)"
+    :js-opts   #js {:href   "https://github.com/swannodette/om"
+                    :target "_none"}}
+   {:render-fn dom/a
+    :text      "Sham (server side)"
+    :js-opts   #js {:href   "https://github.com/pat-thomas/sham"
+                    :target "_none"}}])
+
 (defcomponent home
   (render
-   (dom/div nil "home view will go here")))
+   (apply dom/div nil
+          (map (fn [{:keys [render-fn text js-opts]}]
+                 (dom/div nil (render-fn js-opts text)))
+               home-text))))


Ok, I've managed to make something, it is not even close Scala solution in terms of idiomaticity but it is as close enough as I could manage it in clojure. I've made perhaps some mistakes upwards but really have no time go again over it.

--- src/fpinscala/purely_functional_state.clj
+++ src/fpinscala/purely_functional_state.clj
@@ -401,7 +401,12 @@
          [:coin {:locked true :candies candies :coins coins}] (make-state (machine false candies (inc coins)) nil)
          [:turn {:locked false :candies candies :coins coins}] (make-state (machine true (dec candies) coins) nil))))

+;This is finally, at least - something, not even close Scala variant from FPINS but it is what I could manage
+;with Clojure knowledge at the moment and Scala knowledge (if any) at the moment, I am aware more or less what and how
+;Scala option is doing but moving on anyway as I have no time to go over again. Maybe I'll back to it later.
 (defn simulate-machine [inputs]
   (fn [m]
     (let [{{{:keys [coins candies]} :val} :next-state} ((state-sequence-fpins (map #(modify-state (step-machine %)) inputs)) (make-state m nil))]
       [coins candies])))
+;Where as Scala FPINS variant yields proper State[Machine, (Int, Int)], mine returns just desired "yield" output of FPINS solution
+


Solved 5.13

Solved 5.13

--- src/fpinscala/strictness_and_laziness.clj
+++ src/fpinscala/strictness_and_laziness.clj
@@ -304,3 +304,34 @@
 ;fpins
 ;conceptually - the same :)

+;5.13 - zip-all
+;mine
+(defn zip-all
+  "Zip all for exercise 5.13 of fpins implemented via unfold"
+  [s1 s2]
+  (unfold-fpins [s1 s2] #(let [[[h1 & t1] [h2 & t2]] %]
+                          (cond
+                            (and h1 h2) [[h1 h2] [t1 t2]]
+                            (and h1 (not h2)) [[h1 nil] [t1 nil]]
+                            (and (not h1) h2) [[nil h2] [nil t2]]))))
+;fpins
+;more or less conceptually the same, although in fpins solutions
+;an extra function zipWithAlll has been introduced and that function
+;accepts extra function like so it is more general - like this...
+(defn zip-with-all-fpins
+  "Mimics zipWithAll from fpins"
+  [f s1 s2]
+  (unfold-fpins [s1 s2] #(let [[[h1 & t1] [h2 & t2]] %]
+                          (cond
+                            (and h1 h2) [(f h1 h2) [t1 t2]]
+                            (and h1 (not h2)) [(f h1 nil) [t1 nil]]
+                            (and (not h1) h2) [(f nil h2) [nil t2]]))))
+;although it looks verbose it is simpler than fpins Scala variant as
+;fpins Scala variant relies on Option and pattern matching which in
+;bottom line resulted in much more verbosity - feel free to check it on your own anyway...
+;...and then, zip-all
+(defn zip-all-fpins
+  "Zip all for exercise 5.13 - fpins translation"
+  [s1 s2]
+  (zip-with-all-fpins #(vector %1 %2) s1 s2))
+


CMR-4479: Renamed function; Fixed typos.

--- system-int-test/test/cmr/system_int_test/search/service/concept_retrieval_test.clj
+++ system-int-test/test/cmr/system_int_test/search/service/concept_retrieval_test.clj
@@ -21,19 +21,19 @@
   [(ingest/reset-fixture {"provguid1" "PROV1"})
    service/grant-all-service-fixture]))

-(defn- verify-retrieved-concept
+(defn- assert-retrieved-concept
   "Verify the retrieved concept by checking against the expected service name,
-  which we have deliberately set to be different form each concept revision."
+  which we have deliberately set to be different for each concept revision."
   [concept-id revision-id accept-format expected-service-name]
   (let [{:keys [status body]} (search/retrieve-concept
                                concept-id revision-id {:accept accept-format})]
     (is (= 200 status))
-    (is (=  expected-service-name
-            (:Name (json/parse-string body true))))))
+    (is (= expected-service-name
+           (:Name (json/parse-string body true))))))

 (defmulti handle-retrieve-concept-error
-  "Exectue the retrieve concept call with the given parameters and returns the status and errors
-  based on the result format"
+  "Execute the retrieve concept call with the given parameters and returns the status and errors
+  based on the result format."
   (fn [concept-id revision-id accept-format]
     accept-format))

@@ -50,7 +50,7 @@
    (search/retrieve-concept concept-id revision-id {:accept accept-format
                                                     :throw-exceptions true})))

-(defn- verify-retrieved-concept-error
+(defn- assert-retrieved-concept-error
   "Verify the expected error code and error message are returned when retrieving the given concept."
   [concept-id revision-id accept-format err-code err-message]
   (let [{:keys [status errors]} (handle-retrieve-concept-error
@@ -83,22 +83,22 @@
         (is (= 2 (:revision-id svc1-r2))))

       (testing "retrieval by service concept-id and revision id returns the specified revision"
-        (verify-retrieved-concept concept-id 1 accept-format svc1-r1-name)
-        (verify-retrieved-concept concept-id 2 accept-format svc1-r2-name))
+        (assert-retrieved-concept concept-id 1 accept-format svc1-r1-name)
+        (assert-retrieved-concept concept-id 2 accept-format svc1-r2-name))

       (testing "retrieval by only service concept-id returns the latest revision"
-        (verify-retrieved-concept concept-id nil accept-format svc1-r2-name))
+        (assert-retrieved-concept concept-id nil accept-format svc1-r2-name))

       (testing "retrieval by non-existent revision returns error"
-        (verify-retrieved-concept-error concept-id 3 accept-format 404
+        (assert-retrieved-concept-error concept-id 3 accept-format 404
           (format "Concept with concept-id [%s] and revision-id [3] does not exist." concept-id)))

       (testing "retrieval by non-existent concept-id returns error"
-        (verify-retrieved-concept-error "S404404404-PROV1" nil accept-format 404
+        (assert-retrieved-concept-error "S404404404-PROV1" nil accept-format 404
           "Concept with concept-id [S404404404-PROV1] could not be found."))

       (testing "retrieval by non-existent concept-id and revision-id returns error"
-        (verify-retrieved-concept-error "S404404404-PROV1" 1 accept-format 404
+        (assert-retrieved-concept-error "S404404404-PROV1" 1 accept-format 404
           "Concept with concept-id [S404404404-PROV1] and revision-id [1] does not exist."))

       (testing "retrieval of deleted concept"
@@ -107,11 +107,11 @@
         (index/wait-until-indexed)

         (testing "retrieval of deleted concept without revision id results in error"
-          (verify-retrieved-concept-error concept-id nil accept-format 404
+          (assert-retrieved-concept-error concept-id nil accept-format 404
             (format "Concept with concept-id [%s] could not be found." concept-id)))

         (testing "retrieval of deleted concept with revision id returns a 400 error"
-          (verify-retrieved-concept-error concept-id 3 accept-format 400
+          (assert-retrieved-concept-error concept-id 3 accept-format 400
             (format (str "The revision [3] of concept [%s] represents "
                          "a deleted concept and does not contain metadata.")
                     concept-id)))))))
@@ -119,6 +119,6 @@
 (deftest retrieve-service-with-invalid-format
   (testing "unsupported accept header results in error"
     (let [unsupported-mt "unsupported/mime-type"]
-      (verify-retrieved-concept-error "S1111-PROV1" nil unsupported-mt 400
+      (assert-retrieved-concept-error "S1111-PROV1" nil unsupported-mt 400
         (format "The mime types specified in the accept header [%s] are not supported."
                 unsupported-mt)))))


Add description and URL to jvm project. #7

--- jvm/project.clj
+++ jvm/project.clj
@@ -1,5 +1,6 @@
 (defproject com.parsely/streamparse "0.0.1-SNAPSHOT"
-  :description ""
+  :description "Command line utilities for the Python streamparse library needed for JVM/Thrift interop with Storm clusters."
+  :url "https://github.com/Parsely/streamparse"
   :mailing-list {:name "streamparse"
                  :archive "https://groups.google.com/forum/#!forum/streamparse"
                  :subscribe "streamparse+subscribe@googlegroups.com"


added claims validation tests to jwt tests

--- test/buddy/sign/jwt_tests.clj
+++ test/buddy/sign/jwt_tests.clj
@@ -15,9 +15,26 @@
 (ns buddy.sign.jwt-tests
   (:require [clojure.test :refer :all]
             [buddy.sign.jws :as jws]
-            [buddy.sign.jwt :as jwt]))
+            [buddy.sign.jwt :as jwt]
+            [buddy.sign.util :as util]))

 (def mac-secret "mac-secret")
+
+(defn- unsign-exp-succ
+  ([get-claims-fn signed claims]
+   (unsign-exp-succ get-claims-fn signed claims {}))
+  ([get-claims-fn signed claims opts]
+   (is (= (get-claims-fn signed opts) claims))))
+
+(defn- unsign-exp-fail
+  ([get-claims-fn signed cause]
+   (unsign-exp-fail get-claims-fn signed cause {}))
+  ([get-claims-fn signed cause opts]
+   (try
+     (get-claims-fn signed opts)
+     (throw (Exception. "unexpected"))
+     (catch clojure.lang.ExceptionInfo e
+       (is (= (:cause (ex-data e)) cause))))))

 (deftest jwt-jws-decode
   (let [claims {:aud "buddy"}
@@ -25,3 +42,52 @@
         returned-claims (jwt/get-claims-jws signed mac-secret {:alg :hs256})]
     (is (= returned-claims claims) "decoded claims must match up to original")))

+(defn test-claims-validation [make-jwt-fn get-claims-fn]
+  (let [unsign-exp-succ (partial unsign-exp-succ get-claims-fn)
+        unsign-exp-fail (partial unsign-exp-fail get-claims-fn)]
+    (testing "current time claims validation"
+      (let [now       (util/timestamp)
+            candidate {:foo "bar" :iat now :nbf now :exp (+ now 60)}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-succ signed candidate)))
+
+    (testing ":iat claim validation"
+      (let [candidate {:foo "bar" :iat 10}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-fail signed :iat {:now 0})
+        (unsign-exp-fail signed :iat {:now 9})
+        (unsign-exp-succ signed candidate {:now 10})
+        (unsign-exp-succ signed candidate {:now 11})))
+
+    (testing ":exp claim validation"
+      (let [candidate {:foo "bar" :exp 10}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-succ signed candidate {:now 0})
+        (unsign-exp-succ signed candidate {:now 9})
+        (unsign-exp-fail signed :exp {:now 10})
+        (unsign-exp-fail signed :exp {:now 11})))
+
+    (testing ":nbf claim validation"
+      (let [candidate {:foo "bar" :nbf 10}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-fail signed :nbf {:now 0})
+        (unsign-exp-fail signed :nbf {:now 9})
+        (unsign-exp-succ signed candidate {:now 10})
+        (unsign-exp-succ signed candidate {:now 11})))
+
+    (testing ":iss claim validation"
+      (let [candidate {:foo "bar" :iss "foo:bar"}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-succ signed candidate)
+        (unsign-exp-fail signed :iss {:iss "bar:foo"})))
+
+    (testing ":aud claim validation"
+      (let [candidate {:foo "bar" :aud "foo:bar"}
+            signed    (make-jwt-fn candidate)]
+        (unsign-exp-succ signed candidate)
+        (unsign-exp-fail signed :aud {:aud "bar:foo"})))))
+
+(deftest jws-claims-validation
+  (test-claims-validation (fn [claims] (jws/sign claims mac-secret {:alg :hs256 :typ "JWT"}))
+                          (fn [message opts]
+                            (jwt/get-claims-jws message mac-secret (merge {:alg :hs256} opts)))))


Add messages; tweak parse trees

Add messages; tweak parse trees

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -5,11 +5,13 @@

 (deftest infx-parser-tests
   (is (= [:expr [:ipv4-address "10" "0" "0" "1"]]
-         (#'q/infix-parser "10.0.0.1")))
-  (is (= [:expr [:fn-application
+         (#'q/infix-parser "10.0.0.1"))
+      "infix parses ipv4 addresses")
+  (is (= [:expr [:fn-call
                  [:identifier "ip"]
                  [:identifier "x"]]]
-         (#'q/infix-parser "ip(x)"))))
+         (#'q/infix-parser "ip(x)"))
+      "infix parses simple fn calls"))

 (deftest infix->dsl-tests
   (is (= '(= (:ip x) "10.0.0.1")


Undynamic server

Undynamic server

--- test/icecap/e2e/http_test.clj
+++ test/icecap/e2e/http_test.clj
@@ -6,8 +6,8 @@
             [manifold.deferred :refer [let-flow]]
             [taoensso.timbre :refer [info spy]]))

-(def ^:dynamic http-server)
 (def ^:dynamic recvd-reqs)
+(def http-server)

 (defn handler
   [req]
@@ -25,7 +25,7 @@
 (defn ^:private http-server-fixture
   [f]
   (let [server (http/start-server handler {:port http-server-port})]
-    (binding [http-server server]
+    (with-redefs [http-server server]
       (try (f)
            (finally
              (.close http-server))))))


imports cleanup.

imports cleanup.

--- test/metabase/events_test.clj
+++ test/metabase/events_test.clj
@@ -1,9 +1,7 @@
 (ns metabase.events-test
   (:require [clojure.core.async :as async]
             [expectations :refer :all]
-            [metabase.events :as events]
-            (metabase [task :refer :all]
-                      [test-setup :refer :all])))
+            [metabase.events :as events]))

 (def testing-topic :event-test-topic)


Remove distracting logging of exceptions on validation_test

--- test/onyx/validation_test.clj
+++ test/onyx/validation_test.clj
@@ -1,6 +1,7 @@
 (ns onyx.validation-test
   (:require [onyx.peer.pipeline-extensions :as p-ext]
             [onyx.test-helper :refer [load-config]]
+            [taoensso.timbre :refer [info] :as timbre]
             [midje.sweet :refer :all]
             [onyx.api]))

@@ -8,7 +9,10 @@

 (def config (load-config))

-(def env-config (assoc (:env-config config) :onyx/id id))
+(def env-config (assoc (:env-config config)
+                       :onyx/id id
+                       :onyx.log/config {:appenders {:standard-out {:enabled? false}
+                                                     :spit {:enabled? false}}}))

 (def peer-config
   (assoc (:peer-config config)
@@ -180,4 +184,4 @@
   (fact (:d (:egress-ids c)) => (:id d))
   (fact (:e (:egress-ids d)) => (:id e))
   (fact (:f (:egress-ids e)) => (:id f))
-  (fact (:g (:egress-ids f)) => (:id g)))+  (fact (:g (:egress-ids f)) => (:id g)))


macro refactoring, huh

macro refactoring, huh

--- test/pathfinder/core_test.clj
+++ test/pathfinder/core_test.clj
@@ -56,23 +56,19 @@
     ;; there is N track groups (aka paths)
     (is (= n (count tracks-by-path)))))

-(defn generate-futures
-  [n]
-  (let [fs (mapv
-            (fn [_] (future (test-fn 1 2)))
-            (range n))]
-    (while (not (every? realized? fs))
-      (Thread/sleep 100))))
+(defmacro gen-threads
+  [new-thread wait-thread]
+  `(fn [n#]
+     (->>
+      (range n#)
+      (mapv (fn [_#] (~new-thread (test-fn 1 2))))
+      (mapv ~wait-thread))))

-(defn generate-go-channels
-  [n]
-  (->>
-   (range n)
-   (mapv (fn [_] (a/go (test-fn 1 2))))
-   (mapv #(a/<!! %))))
+(def generate-futures (gen-threads future deref))
+(def generate-go-channels (gen-threads a/go #(a/<!! %)))

 (deftest future-threads-test
   (testing "N futures should produce N different paths"
     (assert-threads-tracks 20 generate-futures))
   (testing "N go channels should produce N different paths"
-    (assert-threads-tracks 2 generate-go-channels)))
+    (assert-threads-tracks 20 generate-go-channels)))


Check for window types with incompatible use of ordered log.

--- src/onyx/windowing/window_extensions.cljc
+++ src/onyx/windowing/window_extensions.cljc
@@ -212,6 +212,9 @@
   (fn [window]
     (:window/type window)))

+(defn ordered-log? [window]
+  (boolean (some #{:ordered-log} (:window/storage-strategy window))))
+
 (defmethod windowing-builder :fixed
   [window]
   (fn [{:keys [range] :as m}]
@@ -222,6 +225,8 @@

 (defmethod windowing-builder :sliding
   [window]
+  (when (ordered-log? window)
+    (throw (ex-info "Ordered log computation of windows is not supported for session windows." {})))
   (fn [{:keys [range slide] :as m}]
     (-> m
         (assoc :units (units/standard-units-for (last range)))
@@ -235,6 +240,8 @@

 (defmethod windowing-builder :session
   [window]
+  (when (ordered-log? window)
+    (throw (ex-info "Ordered log computation of windows is not supported for session windows." {})))
   (fn [{:keys [timeout-gap] :as m}]
     (-> m
         (assoc :units (units/standard-units-for (last timeout-gap)))


A bit more spacing makes this nicer.

A bit more spacing makes this nicer.

--- src/vacation2/main.clj
+++ src/vacation2/main.clj
@@ -11,7 +11,9 @@
   "Log the given arguments. This does nothing, but is overwritten in parse-args
   if the debug option is enabled."
   nil)
+
 (def logger (agent nil))
+
 (defn log-debug [& args]
   "Log the given arguments. This function is used when debugging is enabled."
   (send logger (fn [_] (apply println args))))


added guess

added guess

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -450,6 +450,9 @@
             :english {:participle "grabbing"
                       :past "grabbed"}}

+   "guess" {:synsem {:cat :verb
+                     :sem {:pred :guess}}}
+
    "have" {:synsem {:cat :verb
                     :sem {:activity false
                           :discrete false


reflexives work in spanish (present only so far)

--- src/babel/espanol/grammar.clj
+++ src/babel/espanol/grammar.clj
@@ -368,10 +368,12 @@
     (let [grammar
           (filter #(or (= (:rule %) "s-conditional-nonphrasal")
                        (= (:rule %) "s-present-nonphrasal")
+                       (= (:rule %) "s-present-phrasal")
                        (= (:rule %) "s-future-nonphrasal")
                        (= (:rule %) "s-imperfetto-nonphrasal")
                        (= (:rule %) "s-preterito-nonphrasal")
                        (= (:rule %) "s-aux")
+                       (= (:rule %) "vp-pronoun")
                        (= (:rule %) "vp-aux"))
                   grammar)
           lexicon


register!, shim-react, om-options added

register!, shim-react, om-options added

--- src/core.cljs
+++ src/core.cljs
@@ -24,5 +24,20 @@

 (def register-component (aget (:registry modules) "registerComponent"))

+(defn register! [name mount]
+  (let [registered? (seq (.getAppKeys (:registry modules)))
+        root-tag 1]
+    (if registered?
+      (mount root-tag)
+      (.registerRunnable (:registry modules) #(mount (.rootTag %))))))
+
+(defn shim-react! []
+  (aset (aget (js/eval "goog") "global") "React" (js-obj "Component" (:react-element modules)
+                                                         "createElement" (.-createElement (:react-element modules)))))
+
+(def om-options
+  {:root-render (.-render (:react modules))
+   :root-unmount (.-unmountComponentAtNode (:react modules))})
+
 (defn class [m]
   ((aget (:react modules) "createClass") (clj->js m)))


fixup

fixup

--- src/voke/system/collision/resolution.cljs
+++ src/voke/system/collision/resolution.cljs
@@ -56,7 +56,7 @@
                                                                axis
                                                                new-center)
                                                         all-entities)]
-    (if (> (count contacted-entities) 0)
+    (if (seq contacted-entities)
       (move-to-closest-clear-spot entity axis new-velocity contacted-entities)
       (apply-movement entity {axis new-center} {axis new-velocity}))))


scheduler: Add submit-time to API response schema.

--- scheduler/src/cook/mesos/api.clj
+++ scheduler/src/cook/mesos/api.clj
@@ -150,6 +150,7 @@
   (merge (dissoc JobRequest :user)
          {:framework_id (s/maybe s/Str)
           :status s/Str
+          :submit-time s/Str
           (s/optional-key :gpus) s/Int
           (s/optional-key :instances) [Instance]}))


Add <title> headers.

Add <title> headers.

--- src/wlmmap/handler.clj
+++ src/wlmmap/handler.clj
@@ -118,6 +118,7 @@
   (let [lng (or lang "en")]
     (h/html5
      [:head
+      [:title "Panoramap - explore cultural heritage"]
       (h/include-css "/css/mapbox.css")
       "<!--[if lt IE 8]>"
       (h/include-css "/css/mapbox.ie.css")
@@ -255,6 +256,7 @@
 (defn- links [lang]
   (h/html5
    [:head
+    [:title "Panoramap - explore cultural heritage"]
     (h/include-css "/css/about.css")
     (h/include-js "/js/gg.js")]
    [:body
@@ -267,6 +269,7 @@
 (defn- about [lang & msg]
   (h/html5
    [:head
+    [:title "Panoramap - explore cultural heritage"]
     (h/include-css "/css/about.css")
     (h/include-js "/js/gg.js")]
    [:body


Use mapv (uses transients internally)

Use mapv (uses transients internally)

--- src/zweikopf/multi.clj
+++ src/zweikopf/multi.clj
@@ -60,11 +60,7 @@

   RubyArray
   (clojurize [this ruby]
-    (persistent!
-      (reduce (fn [acc entry]
-                (conj! acc (clojurize entry ruby)))
-              (transient [])
-              this)))
+    (mapv #(clojurize % ruby) this))

   RubyString
   (clojurize [this _]