Various cleanup

Various cleanup

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -1,4 +1,4 @@
-;; # Higher level CSV parsing functionality
+;; # Higher level CSV parsing/processing functionality
 ;;
 ;; The two most popular CSV parsing libraries for Clojure presently - `clojure/data.csv` and `clojure-csv` -
 ;; concern themselves only wtih the _syntax_ of CSV;
@@ -19,9 +19,8 @@
 ;;
 ;; Semantic CSV is structured around a number of composable processing functions for transforming data as it
 ;; comes out of or goes into a CSV file.
-;; This leaves basic parsing/formatting up to you and whatever tools you like to use, as long as those tools
-;; return/take sequences of vectors.
-;; This reflects a nice decoupling of grammar and semantics, maximizing interoperability.
+;; This leaves room for you to use whatever parsing/formatting tools you like, reflecting a nice decoupling
+;; of grammar and semantics.
 ;; However, a couple of convenience functions are also provided which wrap these individual steps
 ;; in an opinionated but customizable manner, helping you move quickly while prototyping or working at the
 ;; REPL.
@@ -60,6 +59,7 @@
 ;; You're welcome.

+;;

 ;; ## mappify

 (defn mappify
@@ -91,6 +91,7 @@
 ;; We can solve this with the following function:

+;;

 ;; ## remove-comments

 (defn remove-comments
@@ -127,6 +128,7 @@
 ;; rather avoid.]

+;;

 ;; ## cast-with

 (defn cast-with
@@ -148,11 +150,33 @@
               cast-fns)))
         (?>> ignore-first (cons (first rows))))))

+;; Note that we have a couple of numeric columns in the play data we've been dealing with.
+;; Let's try casting them as such using `cast-with`:
+;;
+;;     => (with-open [in-file (io/reader "test/test.csv")]
+;;          (->>
+;;            (csv/parse-csv in-file)
+;;            remove-comments
+;;            mappify
+;;            (cast-with {:this #(Integer/parseInt %)})
+;;            doall))
+;;
+;;     ({:this 1, :that "2", :more "stuff"}
+;;      {:this 2, :that "3", :more "other yeah"})
+;;
+;; Lovely :-)
+;;
+;; Note from the implementation here that each row need only be associative.
+;; So map or vector rows are fine, but lists or lazy sequences would not be.
+
+
+;;

+;; ## cast-all

 (defn cast-all
-  "Casts _all_ row values with the given function. Optional `opts` arg accepts keyword args:
-
-  * `:only` - Only run `cast-fn` on these columns
+  "Casts _multiple_ column values with the given function. Optional `opts` map can be used to specify:
+
+  * `:only` - Only run `cast-fn` on these columns (default is to run on all columns)
   * `:ignore-first` - As in `cast-with`, you can optionally ignore the first row"
   ([cast-fn rows]
    (map (partial impl/cast-row cast-fn) rows))
@@ -169,31 +193,12 @@
        (cast-with cast-fns {:ignore-first ignore-first} rows)))))

-;; Note that we have a couple of numeric columns in the play data we've been dealing with.
-;; Let's try casting them as such using `cast-with`:
-;;
-;;     => (with-open [in-file (io/reader "test/test.csv")]
-;;          (->>
-;;            (csv/parse-csv in-file)
-;;            remove-comments
-;;            mappify
-;;            (cast-with {:this #(Integer/parseInt %)})
-;;            doall))
-;;
-;;     ({:this 1, :that "2", :more "stuff"}
-;;      {:this 2, :that "3", :more "other yeah"})
-;;
-;; Lovely :-)
-;;
-;; Note from the implementation here that each row need only be associative.
-;; So map or vector rows are fine, but lists or lazy sequences would not be.
-
-
+;;

 ;; ## process

 (defn process
   "This function wraps together all of the various input processing capabilities into one, with options
-  controlled by an opts hash with opinionated defaults:
+  controlled by an `opts` hash with opinionated defaults:

   * `:header` - bool; consume the first row as a header?
   * `:comment-re` - specify a regular expression to use for commenting out lines, or something falsey
@@ -224,6 +229,7 @@
 ;;                  :cast-fns {:this #(Integer/parseInt %)})))

+;;

 ;; ## parse-and-process

 (defn parse-and-process
@@ -244,9 +250,10 @@
 ;;                            :cast-fns {:this #(Integer/parseInt %)})))

-;; ## slurp-and-process
-
-(defn slurp-and-process
+;;

+;; ## slurp-csv
+
+(defn slurp-csv
   "This convenience function let's you `parse-and-process` csv data given a csv filename. Note that it is _not_
   lazy, and must read in all data so the file handle cna be closed."
   [csv-filename & {:as opts}]
@@ -257,14 +264,12 @@

 ;; For the ultimate in _programmer_ laziness:
 ;;
-;;     (slurp-and-process "test/test.csv"
+;;     (slurp-csv "test/test.csv"
 ;;                        :cast-fns {:this #(Integer/parseInt %)})

 ;;

-
-
-;; # Some parsing functions for your convenience
+;; # Some casting functions for your convenience
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; These functions can be imported and used in your `:cast-fns` specification
@@ -279,10 +284,11 @@
   [string]
   (Float/parseFloat string))

-;;     (slurp-and-process "test/test.csv"
+;;     (slurp-csv "test/test.csv"
 ;;                        :cast-fns {:this ->int})

+;;

 ;; # Output processing functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -297,6 +303,8 @@
 ;; One of the first things we'll need is a function that takes a sequence of maps and turns it into a sequence
 ;; of vectors since this is what most of our csv writing/formatting libraries will want.

+
+;;

 ;; ## vectorize

 (defn vectorize
@@ -347,6 +355,7 @@
 ;;      ["y" "x"])

+;;

 ;; ## format-with

 (defn format-with
@@ -367,14 +376,16 @@
 ;;      ["val-x" "y"])

-;; ## format-all-with
-
-(defn format-all-with
+;;

+;; ## format-with
+
+(defn format-with
   "Just an alias for `cast-all`."
   [& args]
   (apply cast-all args))

+;;

 ;; ## batch

 (defn batch
@@ -393,6 +404,7 @@
 ;; _that_ through to something that writes off the chunks lazily.

+;;

 ;; ## spit-csv

 (defn spit-csv
@@ -427,7 +439,7 @@
                            :prepend-header prepend-header}))
           (?>> formatters (format-with formatters))
           ; For save measure
-          (format-all-with str)
+          (format-with str)
           (batch batch-size)
           (pc/<- (csv/write-csv writer-opts))
           (reduce
@@ -436,13 +448,14 @@
               w)
             file)))))

-;; Like `slurp-and-process`, this is a convenience function which wraps together a set of opinionated options
+;; Like `slurp-csv`, this is a convenience function which wraps together a set of opinionated options
 ;; for writing data to the specified file handle or filename.
 ;; Note that since we use `clojure-csv` here, we offer a `:batch` option that lets you format and write small
 ;; batches of rows out at a time, to avoid contructing a massive string representation of all the data in the
 ;; case of bigger data sets.

+;;

 ;; # One last example showing everything together
 ;;
 ;; Let's see how Semantic CSV in the context of a little data pipeline.
@@ -479,7 +492,7 @@
 ;;       (->>
 ;;         (csv/parse-csv in-file)
 ;;         ...
-;;         (format-all-with str)
+;;         (format-with str)
 ;;         (batch 1)
 ;;         (map csv/write-csv)
 ;;         (reduce


Fix Exception in audio-tags

Fix Exception in audio-tags

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -3,8 +3,7 @@
             [clj-logging-config.jul :refer [set-logger-level!]]
             [clojure.java.io :as io]
             [clojure.pprint :refer [pprint]]
-            [clojure.set :refer [rename-keys]]
-            [clojure.string :refer [join lower-case]])
+            [clojure.set :refer [rename-keys]])
   (:import (java.io File)
            (java.util.logging Level)
            (org.jaudiotagger.audio AudioFileIO)
@@ -33,9 +32,9 @@

 (defn audio-tags [audiofile]
   (when-let [tag (.getTag audiofile)]
-    (try ((convert-longs (into {} (map #(tag-val tag %1) tags))
-                         :year :track))
-         (catch Exception e {})) ))
+    (try (convert-longs (into {} (map #(tag-val tag %1) tags))
+                        :year :track)
+         (catch UnsupportedOperationException e {}))))

 (defn metadata [file]
   (merge {:name (.getName file)


add design document test

add design document test

--- test/joiner/test/core.clj
+++ test/joiner/test/core.clj
@@ -62,4 +62,5 @@
                                               :readers {:roles ["_admin"]}})
                              (design/update-views "testing" "test-view")
                              (is (= 1 (count (:views (clutch/get-document "/_design/testing")))))
-                             (design/update-views "testing" "test-view" "another-view")))))
+                             (design/update-views "testing" "test-view" "another-view")
+                             (is (= 2 (count (:views (clutch/get-document "/_design/testing")))))))))


Removed test message.

Removed test message.

--- src/vertigo/core.clj
+++ src/vertigo/core.clj
@@ -18,7 +18,7 @@
          [:tr
            [:td [:img {:src image}]]
            [:td title]
-           [:td theatre "BOOM"]
+           [:td theatre]
            [:td genres]])])

 (defn shows [shows]


No longer try to coerce filter args to longs in the parser

--- src/selmer/filter_parser.clj
+++ src/selmer/filter_parser.clj
@@ -3,7 +3,8 @@
             [clojure.string :as s]))

 ;;; More Utils
-(defn escape-html* [^String s]
+(defn escape-html*
+  [^String s]
   "HTML-escapes the given string."
   ;; This method is "Java in Clojure" for serious speedups.
   ;; Stolen from davidsantiago/quoin and modified.
@@ -54,9 +55,7 @@
   [args]
   ;; TODO - figure out what kind of extra args filters can take
   (map (fn [^String s]
-         (try (Long/valueOf s)
-              (catch NumberFormatException _
-                (strip-doublequotes s))))
+         (strip-doublequotes s))
        args))

 (defn filter-str->fn


Require clojure.edn explicitly

Require clojure.edn explicitly

Should fix #13.

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -2,6 +2,7 @@
   "Marklogic XCC core functions: session management, querying, type
   conversion, transactions."
   (:require clojure.set
+            clojure.edn
             [clojure.data.json :as json]
             [clojure.data.xml :as xml]
             [slingshot.slingshot :as sling])


create elb with health check

create elb with health check

--- src/shuppet/loadbalancer.clj
+++ src/shuppet/loadbalancer.clj
@@ -7,41 +7,87 @@
    [clojure.zip :as zip]
    [clojure.data.zip.xml :refer [xml1-> attr xml-> text text= attr=]]))

+(def subnet1 "subnet-24df904c")
+(def subnet2 "subnet-bdc08fd5")
+
+(def elb-config-modified
+  { "LoadBalancerName" "nico-test-elb"
+    "Listerners" [{"LoadBalancerPort" 8080
+                   "InstancePort" 8080
+                   "Protocol" "http"
+                   "InstanceProtocol" "http"}]
+    "Subnets" [subnet1 subnet2]
+    "Scheme" "internal"
+    "HealthCheck" {"Target" "HTTP:8080/1.x/ping"
+                   "HealthyThreshold" 2
+                   "UnhealthyThreshold" 2
+                   "Interval" 6
+                   "Timeout" 5}})

-; get 200 when same config
-#(elb-request {"Action" "CreateLoadBalancer"
-              "LoadBalancerName" "recommendations"
-              "Listeners.member.1.LoadBalancerPort" 8080
-              "Listeners.member.1.InstancePort"  8080
-              "Listeners.member.1.Protocol" "http"
-              "Listeners.member.1.InstanceProtocol" "http"
-              "Listeners.member.2.LoadBalancerPort" 80
-              "Listeners.member.2.InstancePort"  8080
-              "Listeners.member.2.Protocol" "http"
-              "Listeners.member.2.InstanceProtocol" "http"
-              "Subnets.member.1" "subnet-24df904c"
-              "Subnets.member.2" "subnet-bdc08fd5"
-              "Scheme" "internal"
-              "SecurityGroups.member.1" "recommendations-lb"
-              "AvailabilityZones.member.1" "eu-west-1a"
-              "AvailabilityZones.member.2" "eu-west-1b"})
+(defn to-aws-format [config]
+
+  )

-#(elb-request {"Action" "CreateLoadBalancerListeners"
-               "LoadBalancerName" "recommendations"
-               "Listeners.member.1.LoadBalancerPort" 80
-               "Listeners.member.1.InstancePort" 8080
-               "Listeners.member.1.InstanceProtocol" "http"
-               "Listeners.member.1.Protocol" "http"})
+(def elb-config { "LoadBalancerName" "nico-test-elb"
+                  "Listeners.member.1.LoadBalancerPort" 8080
+                  "Listeners.member.1.InstancePort"  8080
+                  "Listeners.member.1.Protocol" "http"
+                  "Listeners.member.1.InstanceProtocol" "http"
+                  "Subnets.member.1" subnet1
+                  "Subnets.member.2" subnet2
+                  "Scheme" "internal"
+                  ;health
+                  "HealthCheck.Target" "HTTP:8080/1.x/ping"
+                  "HealthCheck.HealthyThreshold" 2
+                  "HealthCheck.UnhealthyThreshold" 2
+                  "HealthCheck.Interval" 6
+                  "HealthCheck.Timeout" 5
+                  "SecurityGroups.member.1" "nicoelbtest"
+                                        ; "AvailabilityZones.member.1" "eu-west-1a"
+                                        ;"AvailabilityZones.member.2" "eu-west-1b"

-#(elb-request {"Action" "DeleteLoadBalancerListeners"
-              "LoadBalancerName" "recommendations"
-              "LoadBalancerPorts.member.1" "80"})
+                  })
+
+(defn create-elb [config]
+  ;create security group first for elb
+  (elb-request (merge {"Action" "CreateLoadBalancer"} (select-keys config
+                                                             ["LoadBalancerName"
+                                                              "Listeners.member.1.LoadBalancerPort"
+                                                              "Listeners.member.1.InstancePort"
+                                                              "Listeners.member.1.Protocol"
+                                                              "Listeners.member.1.InstanceProtocol"
+                                                              "Subnets.member.1"
+                                                              "Subnets.member.2"
+                                                              "SecurityGroups.member.1"
+                                                              "Scheme" "internal"])))
+  (elb-request (merge {"Action" "ConfigureHealthCheck"} (select-keys config
+                                                                     ["LoadBalancerName"
+                                                                      "HealthCheck.Target"
+                                                                      "HealthCheck.HealthyThreshold"
+                                                                      "HealthCheck.UnhealthyThreshold"
+                                                                      "HealthCheck.Interval"
+                                                                      "HealthCheck.Timeout"]))))

-#(elb-request {"Action" "DescribeLoadBalancers"
-               "LoadBalancerNames.member.1" "recommendations"})
+(defn find-elb [name]
+  (elb-request {"Action" "DescribeLoadBalancers"
+                "LoadBalancerNames.member.1" name}))

-#(elb-request {"Action" "DeleteLoadBalancer"
-              "LoadBalancerName" "test-elb-nico"})
+(defn- create-listeners []
+  (elb-request {"Action" "CreateLoadBalancerListeners"
+                "LoadBalancerName" "recommendations"
+                "Listeners.member.1.LoadBalancerPort" 80
+                "Listeners.member.1.InstancePort" 8080
+                "Listeners.member.1.InstanceProtocol" "http"
+                "Listeners.member.1.Protocol" "http"}))
+
+(defn- delete-listerners []
+  (elb-request {"Action" "DeleteLoadBalancerListeners"
+                "LoadBalancerName" "recommendations"
+                "LoadBalancerPorts.member.1" "80"}))
+
+(defn- delete-elb []
+  (elb-request {"Action" "DeleteLoadBalancer"
+                "LoadBalancerName" "test-elb-nico"}))


new test for simple products

new test for simple products

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -187,6 +187,17 @@
       (fact "variant entities"
             (get-product-data (:db @system) 2)  => (contains {:variants (contains (contains {:type "simple" :sku "sku-2.1"}
                                                                                {:type "simple" :sku "sku-2.2"}))}))
+      (fact "simple product"
+            (get-product-data (:db @system) 1) => (just [{:found         true
+                                                          :is-product    true
+                                                          :is-variant    false
+                                                          :product-id    1
+                                                          :id            1
+                                                          :type          "simple"
+                                                          :sku           "sku-1"
+                                                          :attribute-set 4
+                                                          :date-created  anything
+                                                          :date-updated  anything}]))
       (fact "has meta"
             (meta (get-product-data (:db @system) -1 :debug true)) =not=> nil?)
       (fact "meta contains time and total time"


Fixing issue where status response has no produces

--- src/yada/handler.clj
+++ src/yada/handler.clj
@@ -130,7 +130,7 @@
                          rep (rep/select-best-representation
                               (:request ctx)
                               (if custom-response
-                                (or (:produces custom-response) "text/plain")
+                                (or (:produces custom-response) ["text/plain"])
                                 error-representations)
                               )]


remove expectations

remove expectations

--- ssclj/jar/build.boot
+++ ssclj/jar/build.boot
@@ -61,7 +61,6 @@

                    ;; test dependencies
                    [peridot]
-                   [expectations]
                    [honeysql]

                    ;; boot tasks


Verify response

Verify response

--- src/video_server/omdb.clj
+++ src/video_server/omdb.clj
@@ -55,5 +55,7 @@
 (defn omdb-metadata
   "Queries for metadata related to the given title and year."
   [title & [series year duration]]
-  (retrieve-title title year))
+  (let [resp (retrieve-title title year)]
+    (when (= (:response resp) "True")
+      resp)))


Consistently graspign from perception

Consistently graspign from perception

--- ros/angelic_planning/src/ros/robot.clj
+++ ros/angelic_planning/src/ros/robot.clj
@@ -424,15 +424,15 @@

 (defn open-gripper [nh]
-  (apply-gripper-force nh true -100)
+  (apply-gripper-force nh true 100)
   (unattach-bottle nh)
   )

 (defn close-gripper
-  ([nh] (close-gripper nh 45))
-  ([nh force]
+  ([nh] (close-gripper nh 45 false))
+  ([nh force empty?]
      (apply-gripper-force nh true (- force))
-     (attach-bottle nh)
+     (when-not empty? (attach-bottle nh))
      ))

@@ -1125,6 +1125,22 @@
 (defn find-bottles [nh z]
   (:pts (call-srv nh "/find_bottles" (map-msg FindBottles$Request {:z z}))))

+(defn wait-for-bottle [nh z]
+  (laser-slow)
+  (Thread/sleep 2000)
+  (loop [bottles (find-bottles nh z)]
+    (if (empty? bottles)
+        (do (print ".")
+	    (Thread/sleep 100)
+	    (recur (find-bottles nh z)))
+      (do (future-call laser-fast)
+	  (let [bottles (map #(decode-point (:point %)) bottles)]
+	    (println "Got bottles" bottles)
+	    (util/first-maximal-element
+	     #(- 100 (Math/abs (double (second %))))
+	     bottles)
+	    )))))
+
 (defn compute-base-grasp-rect
   "Given a rectangular table and point in map frame, compute a good base state along x edge.
    Return nil if no pose is thought feasible"
@@ -1177,12 +1193,15 @@
    (do (pt (open-gripper nh)) true)
    (do (Thread/sleep 3000) (final-approach nh obj) true)
    (do (pt (close-gripper nh)) true)
-   (do (Thread/sleep 3000) (move-base-rel nh :vx -0.2) true)
+   (do (Thread/sleep 3000) (move-base-rel nh :vx -0.3) true)
    (pt (move-arm-to-state nh (arm-joint-state true "home") true))))

 (defn grasp-rviz [nh]
   (let [[obj-map obj-bl] (get-rviz-points nh true)]
     (grasp-object nh obj-bl)))
+
+(defn grasp-nearest [nh ht]
+  (grasp-object nh (wait-for-bottle nh ht)))

@@ -1200,13 +1219,13 @@

 ;  TODO: add timeout
 ;; TODO: add preempt
-
 ;; TODO: attach bottles
 ;; TODO: ignore result of arm action.
 ;  TODO: integrate with find_bottles
-;  TODO: extend scrips.
+
+;;  TODO: extend scrips.
     ; Smart script for grasping - move base + ask for new point, if needed.
-
+;; TODO: fix rotate-toa-angle

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     States      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1326,7 +1345,7 @@
 	  (move-arm-to-pos ~'nh ~'j ~'upright?)))

      (defn ~'open [] (open-gripper ~'nh))
-     (defn ~'close ([] (~'close 45)) ([~'f] (close-gripper ~'nh ~'f)))
+     (defn ~'close ([] (~'close 45)) ([~'f] (close-gripper ~'nh ~'f false)))

      (defn ~'home [] (~'go-arm-plan "home"))


a whole new world

a whole new world

--- ros/angelic_planning/src/ros/world.clj
+++ ros/angelic_planning/src/ros/world.clj
@@ -412,7 +412,7 @@
 	     :type :movable :on "endtable" :goal ["table" ] :height 0.2}

     "bottle4" {:xyz [18.8 26.5 0.85] :rpy [0 0 0] :def (get-odwalla)
-	     :type :movable :on "table" :goal ["table" (make-xy-region [16.21 17.0] [26.1 27.0])]
+	     :type :movable :on "table" :goal ["table" (make-xy-region [16.21 17.0] [26.98 27.12])]
 	      :height 0.2}
     }
       d3-res d2-res d2-pad))


hacky fix to work around omnibus not preserving mtime in copies

--- config/software/pcre.clj
+++ config/software/pcre.clj
@@ -23,6 +23,8 @@
                          "CFLAGS" "-L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include"
                          }
                    :args ["--prefix=/opt/opscode/embedded" ]}
+                  ;; touch aclocal.m4 required to avoid trying to regenerate it
+                  {:command "touch" :args ["aclocal.m4"]}
                   {:command "make" :env { "PATH" "/opt/opscode/embedded/bin:/opt/opscode/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/sbin" "LD_RUN_PATH" "/opt/opscode/embedded/lib" }}
                   {:command "make" :args ["install"]}
                   ])


Simplify GL context & locking when setting up terminal

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -254,7 +254,6 @@
              (let [framebuffer-width (.get width-buffer)
                    framebuffer-height (.get height-buffer)]
                (GL11/glViewport 0 0 framebuffer-width framebuffer-height)
-               (GLFW/glfwMakeContextCurrent 0)
                ;; Signal to parent that display has been created
                [window
                 capabilities
@@ -943,21 +942,19 @@
         _                   (log/info "window" window "capabilities" capabilities)
         _                   (log/info "framebuffer size" framebuffer-width "x" framebuffer-height)
         framebuffer-size    (atom [framebuffer-width framebuffer-height])
-        monitor-fullscreen-sizes (with-gl-context gl-lock window capabilities
-                                   (glfw-fullscreen-sizes))
+        monitor-fullscreen-sizes (glfw-fullscreen-sizes)
         _                   (log/info "monitor-fullscreen-sizes" monitor-fullscreen-sizes)

-        group->font-texture (with-gl-context gl-lock window capabilities
-                              (into {}
-                                (mapv (fn [[k v]]
-                                        [k (ref (let [font ((get @v :font) (platform))
-                                                      gg   (if (zfont/glyph-graphics? font)
-                                                               font
-                                                               (zfont/glyph-graphics font))
-                                                      font-texture (texture-id-2d (get gg :font-texture-image))]
-                                                  (log/info "loaded font-texture for" k font-texture (select-keys gg [:font-texture-width :font-texture-height :character-width :character-height]))
-                                               (assoc gg :font-texture font-texture)))])
-                                   group-map)))
+        group->font-texture (into {}
+                              (mapv (fn [[k v]]
+                                      [k (ref (let [font ((get @v :font) (platform))
+                                                    gg   (if (zfont/glyph-graphics? font)
+                                                             font
+                                                             (zfont/glyph-graphics font))
+                                                    font-texture (texture-id-2d (get gg :font-texture-image))]
+                                                (log/info "loaded font-texture for" k font-texture (select-keys gg [:font-texture-width :font-texture-height :character-width :character-height]))
+                                             (assoc gg :font-texture font-texture)))])
+                                 group-map))
         ;; create empty character maps
         layer-character-map-cleared (into {}
                                       (for [[id group-ref] layer-id->group
@@ -1004,48 +1001,44 @@
                                     np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
                                 (log/info "creating buffer for bg textures" np2-columns "x" np2-rows) "x" np2-layers
                                 (BufferUtils/createByteBuffer (* np2-columns np2-rows 4 np2-layers))))
-        glyph-textures      (with-gl-context gl-lock window capabilities
-                              (mapv (fn [layer-group glyph-image-data]
-                                      (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
-                                            np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
-                                            np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
-                                        (log/info "creating glyph texture" np2-columns "x" np2-rows "x" np2-layers)
-                                        (xy-texture-id np2-columns np2-rows np2-layers glyph-image-data)))
-                                    (vals group-map)
-                                    glyph-image-data))
-        fg-textures         (with-gl-context gl-lock window capabilities
-                              (mapv (fn [layer-group fg-image-data]
-                                      (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
-                                            np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
-                                            np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
-                                        (log/info "creating fg texture" np2-columns "x" np2-rows "x" np2-layers)
-                                        (texture-id np2-columns np2-rows np2-layers fg-image-data)))
-                                    (vals group-map)
-                                    fg-image-data))
-        bg-textures         (with-gl-context gl-lock window capabilities
-                              (mapv (fn [layer-group bg-image-data]
-                                      (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
-                                            np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
-                                            np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
-                                        (log/info "creating bg texture" np2-columns "x" np2-rows "x" np2-layers)
-                                        (texture-id np2-columns np2-rows np2-layers bg-image-data)))
-                                    (vals group-map)
-                                    bg-image-data))
-        [fbo-id fbo-texture]
-                            (with-gl-context gl-lock window capabilities (fbo-texture framebuffer-width framebuffer-height))
+        glyph-textures      (mapv (fn [layer-group glyph-image-data]
+                                    (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
+                                          np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
+                                          np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
+                                      (log/info "creating glyph texture" np2-columns "x" np2-rows "x" np2-layers)
+                                      (xy-texture-id np2-columns np2-rows np2-layers glyph-image-data)))
+                                  (vals group-map)
+                                  glyph-image-data)
+        fg-textures        (mapv (fn [layer-group fg-image-data]
+                                   (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
+                                         np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
+                                         np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
+                                     (log/info "creating fg texture" np2-columns "x" np2-rows "x" np2-layers)
+                                     (texture-id np2-columns np2-rows np2-layers fg-image-data)))
+                                 (vals group-map)
+                                 fg-image-data)
+        bg-textures         (mapv (fn [layer-group bg-image-data]
+                                    (let [np2-columns (zutil/next-pow-2 (get @layer-group :columns))
+                                          np2-rows    (zutil/next-pow-2 (get @layer-group :rows))
+                                          np2-layers  (zutil/next-pow-2 (count (get @layer-group :layers)))]
+                                      (log/info "creating bg texture" np2-columns "x" np2-rows "x" np2-layers)
+                                      (texture-id np2-columns np2-rows np2-layers bg-image-data)))
+                                  (vals group-map)
+                                  bg-image-data)
+        [fbo-id fbo-texture] (fbo-texture framebuffer-width framebuffer-height)
         ; init shaders
         [^int pgm-id
-         ^int fb-pgm-id]                   (with-gl-context gl-lock window capabilities (init-shaders (get fx-shader :name)))
-        pos-vertex-attribute               (with-gl-context gl-lock window capabilities (GL20/glGetAttribLocation pgm-id "aVertexPosition"))
-        texture-coords-vertex-attribute    (with-gl-context gl-lock window capabilities (GL20/glGetAttribLocation pgm-id "aTextureCoord"))
-        fb-pos-vertex-attribute            (with-gl-context gl-lock window capabilities (GL20/glGetAttribLocation fb-pgm-id "aVertexPosition"))
-        fb-texture-coords-vertex-attribute (with-gl-context gl-lock window capabilities (GL20/glGetAttribLocation fb-pgm-id "aTextureCoord"))
+         ^int fb-pgm-id]      (init-shaders (get fx-shader :name))
+        pos-vertex-attribute  (GL20/glGetAttribLocation pgm-id "aVertexPosition")
+        texture-coords-vertex-attribute    (GL20/glGetAttribLocation pgm-id "aTextureCoord")
+        fb-pos-vertex-attribute            (GL20/glGetAttribLocation fb-pgm-id "aVertexPosition")
+        fb-texture-coords-vertex-attribute (GL20/glGetAttribLocation fb-pgm-id "aTextureCoord")

         ;; We just need one vertex buffer, a texture-mapped quad will suffice for drawing the terminal.
         {:keys [vertices-vbo-id
                 vertices-count
                 texture-coords-vbo-id
-                vao-id]}   (with-gl-context gl-lock window capabilities (init-buffers))
+                vao-id]}   (init-buffers)
         [glyph-tex-dim
          u-MVMatrix
          u-PMatrix
@@ -1056,47 +1049,43 @@
          u-num-layers
          font-size
          term-dim
-         font-tex-dim]     (with-gl-context gl-lock window capabilities
-                             (mapv #(GL20/glGetUniformLocation pgm-id (str %))
-                                   ["glyphTextureDimensions"
-                                    "uMVMatrix"
-                                    "uPMatrix"
-                                    "uFont"
-                                    "uGlyphs"
-                                    "uFg"
-                                    "uBg"
-                                    "numLayers"
-                                    "fontSize"
-                                    "termDimensions"
-                                    "fontTextureDimensions"]))
+         font-tex-dim]     (mapv #(GL20/glGetUniformLocation pgm-id (str %))
+                                 ["glyphTextureDimensions"
+                                  "uMVMatrix"
+                                  "uPMatrix"
+                                  "uFont"
+                                  "uGlyphs"
+                                  "uFg"
+                                  "uBg"
+                                  "numLayers"
+                                  "fontSize"
+                                  "termDimensions"
+                                  "fontTextureDimensions"])
         [u-fb
          u-fb-MVMatrix
-         u-fb-PMatrix]     (with-gl-context gl-lock window capabilities
-                             (mapv #(GL20/glGetUniformLocation fb-pgm-id (str %))
-                                   ["uFb"
-                                    "uMVMatrix"
-                                    "uPMatrix"]))
+         u-fb-PMatrix]     (mapv #(GL20/glGetUniformLocation fb-pgm-id (str %))
+                                 ["uFb"
+                                  "uMVMatrix"
+                                  "uPMatrix"])
         ;; map from uniform name (string) to [value atom, uniform location]
         fx-uniforms        (reduce (fn [uniforms [uniform-name value]]
                                      (assoc uniforms
                                             uniform-name
                                             [(atom value)
-                                             (with-gl-context gl-lock window capabilities
-                                               (log/info "getting location of uniform" uniform-name)
-                                               (let [location (GL20/glGetUniformLocation fb-pgm-id (str uniform-name))]
-                                                 (assert (not (neg? location)) (str "Could not find location for uniform " uniform-name location))
-                                                 (log/info "got location of uniform" uniform-name location)
-                                                 location))]))
+                                             (log/info "getting location of uniform" uniform-name)
+                                             (let [location (GL20/glGetUniformLocation fb-pgm-id (str uniform-name))]
+                                               (assert (not (neg? location)) (str "Could not find location for uniform " uniform-name location))
+                                               (log/info "got location of uniform" uniform-name location)
+                                               location)]))
                                    {}
                                    (get fx-shader :uniforms))
-        _                  (with-gl-context gl-lock window capabilities
-                             (doseq [idx (range (GL20/glGetProgrami fb-pgm-id GL20/GL_ACTIVE_UNIFORMS))]
-                               (let [length-buffer (BufferUtils/createIntBuffer 1)
-                                     size-buffer (BufferUtils/createIntBuffer 1)
-                                     type-buffer (BufferUtils/createIntBuffer 1)
-                                     name-buffer (BufferUtils/createByteBuffer 100)
-                                     uniform-name (GL20/glGetActiveUniform fb-pgm-id idx 256 size-buffer type-buffer)]
-                               (log/info "Found uniform" uniform-name))))
+        _                  (doseq [idx (range (GL20/glGetProgrami fb-pgm-id GL20/GL_ACTIVE_UNIFORMS))]
+                             (let [length-buffer (BufferUtils/createIntBuffer 1)
+                                   size-buffer (BufferUtils/createIntBuffer 1)
+                                   type-buffer (BufferUtils/createIntBuffer 1)
+                                   name-buffer (BufferUtils/createByteBuffer 100)
+                                   uniform-name (GL20/glGetActiveUniform fb-pgm-id idx 256 size-buffer type-buffer)]
+                               (log/info "Found uniform" uniform-name)))
         key-callback          (proxy [GLFWKeyCallback] []
                                 (invoke [window key scancode action mods]
                                   (when-let [key (zkeyboard/convert-key-code key scancode action mods)]
@@ -1163,8 +1152,7 @@
                             :attributes {:pos-vertex-attribute pos-vertex-attribute
                                          :texture-coords-vertex-attribute texture-coords-vertex-attribute
                                          :fb-pos-vertex-attribute fb-pos-vertex-attribute
-                                         :fb-texture-coords-vertex-attribute fb-texture-coords-vertex-attribute
-}
+                                         :fb-texture-coords-vertex-attribute fb-texture-coords-vertex-attribute}
                             :program-id pgm-id
                             :fb-program-id fb-pgm-id
                             :uniforms {:u-MVMatrix u-MVMatrix
@@ -1210,105 +1198,107 @@
                                             destroyed
                                             window
                                             capabilities)]
-    ;; Access to terminal will be multi threaded. Release context so that other threads can access it)))
-    (when fullscreen
-      (zat/set-window-size! terminal (first (zat/fullscreen-sizes terminal))))
-    ;; Start font file change listener thread
-    ; TODO: fix resource reloader
-    #_(cwc/start-watch [{:path "./fonts"
-                       :event-types [:modify]
-                       :bootstrap (fn [path] (println "Starting to watch " path))
-                       :callback (fn [_ filename]
-                                   (println "Reloading font" filename)
-                                   (reset! normal-font
-                                           (make-font filename Font/PLAIN font-size)))
-                       :options {:recursive true}}])
-    ;; Poll keyboard in background thread and offer input to key-chan
-    ;; If gl-lock is false ie: the window has been closed, put :exit on the term-chan
-    (reset! key-callback-atom key-callback)
-    (reset! char-callback-atom char-callback)
-    (reset! mouse-button-callback-atom mouse-button-callback)
-    (reset! cursor-pos-callback-atom cursor-pos-callback)
-    (GLFW/glfwSetKeyCallback window key-callback)
-    (GLFW/glfwSetCharCallback window char-callback)
-    (GLFW/glfwSetMouseButtonCallback window mouse-button-callback)
-    (GLFW/glfwSetCursorPosCallback window cursor-pos-callback)
-    (future
-      ;; Wait for main thread loop to start
-      (.await latch)
-      (f terminal))
-    (let [primary-video-mode (with-gl-context gl-lock window capabilities
-                               (GLFW/glfwGetVideoMode (GLFW/glfwGetPrimaryMonitor)))
-          current-video-mode (atom (with-gl-context gl-lock window capabilities
-                                     (glfw-current-monitor window)))]
-      (log/info "current-video-mode" @current-video-mode)
-      (reset! window-size @current-video-mode)
-      (loop []
-        (.countDown latch)
-        (if (with-gl-context gl-lock window capabilities
-              (except-gl-errors "Start of loop")
-              ; Process messages in the main thread rather than the input go-loop due to Windows only allowing
-              ; input on the thread that created the window
-              (GLFW/glfwPollEvents)
-              ;; Close the display if the close window button has been clicked
-              ;; or the gl-lock has been released programmatically (e.g. by destroy!)
-              (or (GLFW/glfwWindowShouldClose window) @destroyed))
-          (do
-            (log/info "Destroying display")
-            (with-gl-context gl-lock window capabilities
-              (reset! gl-lock false)
-              ;; TODO: Clean up textures and programs
-              ;;(let [{{:keys [vertices-vbo-id vertices-count texture-coords-vbo-id vao-id fbo-id]} :buffers
-              ;;       {:keys [font-texture glyph-texture fg-texture bg-texture fbo-texture]} :textures
-              ;;       program-id :program-id
-              ;;       fb-program-id :fb-program-id} gl]
-                (doseq [id [pgm-id fb-pgm-id]]
-                  (GL20/glDeleteProgram (int id)))
-                (doseq [id (flatten [[fbo-texture] glyph-textures fg-textures bg-textures])]
-                  (GL11/glDeleteTextures (int id))))
-              (GLFW/glfwDestroyWindow window)
-            (log/info "Exiting"))
-          (do
-            (when-not (= @current-video-mode @window-size)
-              (log/info "window change. Old size" @current-video-mode "New size" @window-size)
-              (with-gl-context gl-lock window capabilities
-                (cond
-                  ;; fullscreen mode
-                  (pos? (get @window-size :monitor 0))
-                  (let [{:keys [width height refresh-rate monitor]} @window-size]
-                    (log/info "setting window monitor fullscreen" window monitor 0 0 width height refresh-rate)
-                    (GLFW/glfwSetWindowMonitor window
-                                               monitor
-                                               0
-                                               0
-                                               width
-                                               height
-                                               refresh-rate))
-                  ;; fullscren -> windowed mode
-                  (pos? (get @current-video-mode :monitor 0))
-                  (let [{:keys [width height]} @window-size]
-                    (log/info "setting window monitor windowed from fullscreen" window 0 0 0 width height 0)
-                    (GLFW/glfwSetWindowMonitor window
-                                               (long 0)
-                                               (int 0)
-                                               (int 0)
-                                               (int width)
-                                               (int height)
-                                               (int 0)))
-                  :else
-                  (let [{:keys [width height]} @window-size]
-                    (log/info "setting window monitor windowed from windowed" window 0 0 0 width height 0)
-                    (GLFW/glfwSetWindowSize window width height)
-                    (GLFW/glfwSetWindowPos window (quot (- (.width primary-video-mode) screen-width) 2)
-                                                  (quot (- (.height primary-video-mode) screen-height) 2))
-                    (let [[framebuffer-width framebuffer-height :as fb-size] (glfw-framebuffer-size window)
-                          ^ByteBuffer bbnil nil]
-                      (reset! framebuffer-size fb-size)
-                      (log/info "Changing size of fbo" fbo-texture)
-                      (GL11/glBindTexture GL11/GL_TEXTURE_2D fbo-texture)
-                      (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB framebuffer-width framebuffer-height 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bbnil)
-                      (GL11/glBindTexture GL11/GL_TEXTURE_2D 0))))
-                (reset! current-video-mode @window-size)))
-            (GLFW/glfwWaitEvents)
-            (recur)))))))
+        ;; Release gl context before starting terminal
+        (GLFW/glfwMakeContextCurrent 0)
+        ;; Access to terminal will be multi threaded. Release context so that other threads can access it
+        (when fullscreen
+          (zat/set-window-size! terminal (first (zat/fullscreen-sizes terminal))))
+        ;; Start font file change listener thread
+        ; TODO: fix resource reloader
+        #_(cwc/start-watch [{:path "./fonts"
+                           :event-types [:modify]
+                           :bootstrap (fn [path] (println "Starting to watch " path))
+                           :callback (fn [_ filename]
+                                       (println "Reloading font" filename)
+                                       (reset! normal-font
+                                               (make-font filename Font/PLAIN font-size)))
+                           :options {:recursive true}}])
+        ;; Poll keyboard in background thread and offer input to key-chan
+        ;; If gl-lock is false ie: the window has been closed, put :exit on the term-chan
+        (reset! key-callback-atom key-callback)
+        (reset! char-callback-atom char-callback)
+        (reset! mouse-button-callback-atom mouse-button-callback)
+        (reset! cursor-pos-callback-atom cursor-pos-callback)
+        (GLFW/glfwSetKeyCallback window key-callback)
+        (GLFW/glfwSetCharCallback window char-callback)
+        (GLFW/glfwSetMouseButtonCallback window mouse-button-callback)
+        (GLFW/glfwSetCursorPosCallback window cursor-pos-callback)
+        (future
+          ;; Wait for main thread loop to start
+          (.await latch)
+          (f terminal))
+        (let [primary-video-mode (with-gl-context gl-lock window capabilities
+                                   (GLFW/glfwGetVideoMode (GLFW/glfwGetPrimaryMonitor)))
+              current-video-mode (atom (with-gl-context gl-lock window capabilities
+                                         (glfw-current-monitor window)))]
+          (log/info "current-video-mode" @current-video-mode)
+          (reset! window-size @current-video-mode)
+          (loop []
+            (.countDown latch)
+            (if (with-gl-context gl-lock window capabilities
+                  (except-gl-errors "Start of loop")
+                  ; Process messages in the main thread rather than the input go-loop due to Windows only allowing
+                  ; input on the thread that created the window
+                  (GLFW/glfwPollEvents)
+                  ;; Close the display if the close window button has been clicked
+                  ;; or the gl-lock has been released programmatically (e.g. by destroy!)
+                  (or (GLFW/glfwWindowShouldClose window) @destroyed))
+              (do
+                (log/info "Destroying display")
+                (with-gl-context gl-lock window capabilities
+                  (reset! gl-lock false)
+                  ;; TODO: Clean up textures and programs
+                  ;;(let [{{:keys [vertices-vbo-id vertices-count texture-coords-vbo-id vao-id fbo-id]} :buffers
+                  ;;       {:keys [font-texture glyph-texture fg-texture bg-texture fbo-texture]} :textures
+                  ;;       program-id :program-id
+                  ;;       fb-program-id :fb-program-id} gl]
+                    (doseq [id [pgm-id fb-pgm-id]]
+                      (GL20/glDeleteProgram (int id)))
+                    (doseq [id (flatten [[fbo-texture] glyph-textures fg-textures bg-textures])]
+                      (GL11/glDeleteTextures (int id))))
+                  (GLFW/glfwDestroyWindow window)
+                (log/info "Exiting"))
+              (do
+                (when-not (= @current-video-mode @window-size)
+                  (log/info "window change. Old size" @current-video-mode "New size" @window-size)
+                  (with-gl-context gl-lock window capabilities
+                    (cond
+                      ;; fullscreen mode
+                      (pos? (get @window-size :monitor 0))
+                      (let [{:keys [width height refresh-rate monitor]} @window-size]
+                        (log/info "setting window monitor fullscreen" window monitor 0 0 width height refresh-rate)
+                        (GLFW/glfwSetWindowMonitor window
+                                                   monitor
+                                                   0
+                                                   0
+                                                   width
+                                                   height
+                                                   refresh-rate))
+                      ;; fullscren -> windowed mode
+                      (pos? (get @current-video-mode :monitor 0))
+                      (let [{:keys [width height]} @window-size]
+                        (log/info "setting window monitor windowed from fullscreen" window 0 0 0 width height 0)
+                        (GLFW/glfwSetWindowMonitor window
+                                                   (long 0)
+                                                   (int 0)
+                                                   (int 0)
+                                                   (int width)
+                                                   (int height)
+                                                   (int 0)))
+                      :else
+                      (let [{:keys [width height]} @window-size]
+                        (log/info "setting window monitor windowed from windowed" window 0 0 0 width height 0)
+                        (GLFW/glfwSetWindowSize window width height)
+                        (GLFW/glfwSetWindowPos window (quot (- (.width primary-video-mode) screen-width) 2)
+                                                      (quot (- (.height primary-video-mode) screen-height) 2))
+                        (let [[framebuffer-width framebuffer-height :as fb-size] (glfw-framebuffer-size window)
+                              ^ByteBuffer bbnil nil]
+                          (reset! framebuffer-size fb-size)
+                          (log/info "Changing size of fbo" fbo-texture)
+                          (GL11/glBindTexture GL11/GL_TEXTURE_2D fbo-texture)
+                          (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB framebuffer-width framebuffer-height 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bbnil)
+                          (GL11/glBindTexture GL11/GL_TEXTURE_2D 0))))
+                    (reset! current-video-mode @window-size)))
+                (GLFW/glfwWaitEvents)
+                (recur)))))))


send less data to the about button

send less data to the about button

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -97,12 +97,12 @@
              [:i.unseen-eids (str unread-chat-count)])
            (common/icon :chat)])))))

-(defn about-button [app owner]
+(defn about-button [data owner]
   (reify
     om/IRender
     (render [_]
       (let [cast! (om/get-shared owner :cast!)
-            info-button-learned? (get-in app state/info-button-learned-path)]
+            info-button-learned? (get-in data state/info-button-learned-path)]
         (html
           [:a.about-info {:on-click #(cast! :overlay-info-toggled)
                           :role "button"
@@ -186,7 +186,7 @@
                 (om/build canvas/svg-canvas app)
                 (om/build chat-menu-button app)
                 (when-not (:cust app)
-                  (om/build about-button app))
+                  (om/build about-button (select-in app [state/info-button-learned-path])))
                 ; (om/build main-actions (select-in app [state/aside-menu-opened-path
                 ;                                        state/menu-button-learned-path
                 ;                                        state/info-button-learned-path


Update dev urls

Update dev urls


debugger: on Replay and Vacuum preserve signals which have children with actions

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -102,15 +102,50 @@
        (filter #(= (:id %) id))
        first))

-(defn -orphaned-signal?
-  "Orphaned signal has no actions."
-  [model signal]
-  (empty? (filter #(= (:signal-id %) (:id signal))
-                  (-> model ::debugger :action-events))))
+(defn -signal-id->parent-id
+  "Returns a map."
+  [signal-events]
+  (let [result (atom {})]
+    (doseq [{:keys [id parent-id]} signal-events]
+      (swap! result assoc id parent-id))
+
+    @result))
+
+(defn -signal-parent-ids
+  "Returns a set containing: id of parent, parent of parent, etc.
+  Non-existent parent ids are ignored."
+  [id->parent-id id]
+  {:pre [(map? id->parent-id)]}
+  (let [existing-ids (keys id->parent-id)
+        result (atom #{})]
+    (loop [child-id id]
+      (let [parent-id (id->parent-id child-id)]
+        (if (some #{parent-id} existing-ids)
+          (do
+            (swap! result conj parent-id)
+            (recur parent-id))
+
+          @result)))))
+
+(defn -signals-with-actions
+  "Returns set of ids of signals which have actions or child signals with actions."
+  [model]
+  (let [signal-id->parent-id (-signal-id->parent-id (-> model ::debugger :signal-events))
+        result (atom #{})]
+    ; loop through actions and collect all their parents, parents of parents, etc.
+    (doseq [{:keys [signal-id]} (-> model ::debugger :action-events)]
+      (swap! result conj signal-id)
+      (swap! result into (-signal-parent-ids signal-id->parent-id signal-id)))
+
+    @result))

 (defn -remove-orphaned-signals
+  "Orphaned signal has no actions and no orphaned child signals."
   [model]
-  (update-in model [::debugger :signal-events] #(remove (partial -orphaned-signal? model) %)))
+  (let [kept-ids (-signals-with-actions model)
+        signal-events (-> model ::debugger :signal-events)
+        new-signal-events (filter #(contains? kept-ids (:id %)) signal-events)]
+    (assoc-in model [::debugger :signal-events] new-signal-events)))

 ;;;;;;;;;;;;;;;;;;;;;;;; Control
 (defn -save-file
@@ -296,42 +331,24 @@
                  (reconcile [::app-action (:id unknown-signal-event) action]))))))

 ;;;;;;;;;;;;;;;;;;;;;;;; View model
-(defn -signal-parent-ids
-  "Returns a set containing: id of parent, parent of parent, etc.
-  Removed parent ids are ignored."
-  [signal-events id]
-  (let [id->parent-id (atom {})
-        result (atom #{})]
-    (doseq [{:keys [id parent-id]} signal-events]
-      (swap! id->parent-id assoc id parent-id))
-
-    (let [existing-ids (keys @id->parent-id)]
-      (loop [child-id id]
-        (let [parent-id (@id->parent-id child-id)]
-          (if (some #{parent-id} existing-ids)
-            (do
-              (swap! result conj parent-id)
-              (recur parent-id))
-
-            @result))))))
-
 (defn -signal-indent
-  [signal-events id]
-  (count (-signal-parent-ids signal-events id)))
+  [signal-id->parent-id id]
+  (count (-signal-parent-ids signal-id->parent-id id)))

 (defn -view-model
   [model]
   (let [debugger (reaction (::debugger @model))
         signal-events (reaction (-> @debugger :signal-events))
+        signal-id->parent-id (reaction (-signal-id->parent-id @signal-events))
         highlighted-signal-id (reaction (-> @debugger :highlighted-signal-id))
-        highlighted-signal-ids (reaction (into #{@highlighted-signal-id}
-                                               (-signal-parent-ids @signal-events @highlighted-signal-id)))]
+        highlighted-signal-ids (reaction #(into #{@highlighted-signal-id}
+                                                (-signal-parent-ids @signal-id->parent-id @highlighted-signal-id)))]
     (-> (mvsa/track-keys debugger
                          [:initial-model :replay-mode? :visible? :toggle-visibility-shortcut :action-events])
         (assoc :signal-events (reaction
                                 ; mapv instead of map is essential, without it referenced reactions will be recalculated several times
                                 (mapv #(assoc % :highlighted? (contains? @highlighted-signal-ids (:id %))
-                                                :indent (-signal-indent @signal-events (:id %)))
+                                                :indent (-signal-indent @signal-id->parent-id (:id %)))
                                       @signal-events))))))

 ;;;;;;;;;;;;;;;;;;;;;;;; View


Fix auth tests broken with previous changes.

--- test/uxbox/tests/test_auth.clj
+++ test/uxbox/tests/test_auth.clj
@@ -16,7 +16,7 @@
   (let [data {:username "user1"
               :fullname "user 1"
               :metadata "1"
-              :password  (hashers/encrypt "user1")
+              :password  "user1"
               :email "user1@uxbox.io"}
         user (with-open [conn (db/connection)]
                (usu/create-user conn data))]
@@ -27,7 +27,7 @@
                   :scope "foobar"}
             uri (str th/+base-url+ "/api/auth/token")
             [status data] (th/http-post uri {:body data})]
-        ;; (println "RESPONSE:" response)
+        ;; (println "RESPONSE:" status data)
         (t/is (= status 200))
         (t/is (contains? data :token))))))


tweak the chat dummy message

tweak the chat dummy message

--- src-cljs/frontend/components/chat.cljs
+++ src-cljs/frontend/components/chat.cljs
@@ -10,8 +10,11 @@
             [frontend.components.common :as common]
             [frontend.datascript :as ds]
             [frontend.datetime :as datetime]
+            [frontend.db :as fdb]
             [frontend.models.chat :as chat-model]
+            [frontend.models.doc :as doc-model]
             [frontend.state :as state]
+            [frontend.urls :as urls]
             [frontend.utils :as utils :include-macros true]
             [goog.date]
             [goog.dom]
@@ -174,6 +177,7 @@
        :touch-enabled? false})
     om/IDidMount
     (did-mount [_]
+      (fdb/watch-doc-name-changes owner)
       (om/set-state! owner :touch-enabled? (.hasOwnProperty js/window "ontouchstart"))
       (d/listen! (om/get-shared owner :db)
                  (om/get-state owner :listener-key)
@@ -206,6 +210,7 @@
       (let [{:keys [cast! db]} (om/get-shared owner)
             chats (ds/touch-all '[:find ?t :where [?t :chat/body]] @db)
             chat-bot (:document/chat-bot (d/entity @db (ffirst (d/q '[:find ?t :where [?t :document/name]] @db))))
+            doc (doc-model/find-by-id @db (:document/id app))
             dummy-chat {:chat/body [:span
                                     "Welcome, try the "
                                     [:a {:href "https://precursorapp.com/document/17592197661008" :target "_blank"}
@@ -213,10 +218,13 @@
                                     " doc, see other users "
                                     [:a {:href "/blog/ideas-are-made-with-precursor" :target "_blank"}
                                      "make"]
-                                    " things, or ask us "
+                                    " things, "
+                                    [:a {:href (urls/overlay-path doc "sharing")}
+                                     "invite a friend"]
+                                    " or ping "
                                     [:a {:on-click #(cast! :chat-user-clicked {:id-str (:chat-bot/name chat-bot)}) :role "button"}
-                                     "anything"]
-                                    "!"]
+                                     (str "@" (:chat-bot/name chat-bot))]
+                                    " for help!"]
                         :cust/uuid (:cust/uuid state/subscriber-bot)
                         :server/timestamp (js/Date.)}]
         (html


small view fixes

small view fixes

--- src-cljs/frontend/components/plan.cljs
+++ src-cljs/frontend/components/plan.cljs
@@ -49,21 +49,21 @@
                            (om/set-state! owner :new-email ""))]
         (html
          [:div
-          [:div {:ref "billing-email"
-                 :content-editable (if (om/get-state owner :editing-email?) true false)
-                 :spell-check false
-                 :on-key-down #(do
-                                 (when (= "Enter" (.-key %))
-                                   (.preventDefault %)
-                                   (submit-fn)
-                                   (utils/stop-event %))
-                                 (when (= "Escape" (.-key %))
-                                   (om/set-state! owner :editing-email? false)
-                                   (om/set-state! owner :new-email "")
-                                   (utils/stop-event %)))
-                 :on-blur #(do (submit-fn)
-                               (utils/stop-event %))
-                 :on-input #(om/set-state-nr! owner :new-email (goog.dom/getRawTextContent (.-target %)))}
+          [:div.billing-email {:ref "billing-email"
+                               :content-editable (if (om/get-state owner :editing-email?) true false)
+                               :spell-check false
+                               :on-key-down #(do
+                                               (when (= "Enter" (.-key %))
+                                                 (.preventDefault %)
+                                                 (submit-fn)
+                                                 (utils/stop-event %))
+                                               (when (= "Escape" (.-key %))
+                                                 (om/set-state! owner :editing-email? false)
+                                                 (om/set-state! owner :new-email "")
+                                                 (utils/stop-event %)))
+                               :on-blur #(do (submit-fn)
+                                             (utils/stop-event %))
+                               :on-input #(om/set-state-nr! owner :new-email (goog.dom/getRawTextContent (.-target %)))}
            (:plan/billing-email plan)]
           [:a {:on-click #(do
                             (om/set-state! owner :editing-email? true)
@@ -81,28 +81,30 @@
       (let [{:keys [cast! team-db]} (om/get-shared owner)]
         (html
          [:div.make
-          [:h4.make "Credit card"]
-          [:p.make
+          [:h4 "Credit card"]
+          [:p
            (for [[k v] (filter #(= "credit-card" (namespace (first %))) plan)
                  :let [v (str v)]]
              [:tr.make
               [:td [:div {:title k} (str k)]]
               [:td [:div.connection-result {:title v}
                     v]]])]
-          [:a.make {:on-click #(cast! :change-card-clicked)
-                    :role "button"}
+          [:a {:on-click #(cast! :change-card-clicked)
+               :role "button"}
            "Change card"]
+          [:h4 "Billing email"]
+          [:p "We'll send invoices to this email."]
           (om/build billing-email {:plan plan})
-          [:h4.make "Usage"]
+          [:h4 "Usage"]
           (when (plan-model/in-trial? plan)
-            [:p.make
+            [:p
              "You still have "
              [:span {:title (:plan/trial-end plan)}
               (time-left plan)]
              " left in your trial. We won't start charging until your trial is over."])
-          [:p.make "You pay $10/month for every active user on your team. Add users from the "
-           [:a.make {:on-click #(cast! :team-settings-opened)
-                     :role "button"}
+          [:p "You pay $10/month for every active user on your team. Add users from the "
+           [:a {:on-click #(cast! :team-settings-opened)
+                :role "button"}
             "team permissions"]
            " page."]])))))


Show flash notification when user adds env var

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -532,7 +532,8 @@
     (-> state
         (update-in state/project-envvars-path (fnil conj []) resp)
         (assoc-in (conj state/inputs-path :new-env-var-name) "")
-        (assoc-in (conj state/inputs-path :new-env-var-value) ""))))
+        (assoc-in (conj state/inputs-path :new-env-var-value) "")
+        (state/add-flash-notification "Environment variable added successfully."))))

 (defmethod post-api-event! [:create-env-var :success]
   [target message status {:keys [context]} previous-state current-state]


Fill in expected values.

Fill in expected values.


Work on updates

Work on updates

--- ros/angelic_planning/src/ros/robot.clj
+++ ros/angelic_planning/src/ros/robot.clj
@@ -44,38 +44,24 @@

 (def nh (.createNodeHandle *ros*))

-(defmsgs [ros.pkg
-	  [roslib.msg Header]
-	  [std_msgs.msg ColorRGBA Float64]
-	  [robot_msgs.msg
-	     ; OccGrid MapMetaData
-	     Point PointStamped Vector3 Quaternion
-	     Velocity AngularVelocity Acceleration AngularAcceleration
-	     Pose PoseDot PoseDDot PoseStamped PoseWithRatesStamped]
-	  [robot_actions.msg ActionStatus]
-	  [nav_robot_actions.msg MoveBaseState]
-	  [motion_planning_msgs.msg
+(defmsgs  [std_msgs Float64]
+	  [robot_msgs PointStamped PoseStamped PoseWithRatesStamped]
+	  [nav_robot_actions MoveBaseState]
+	  [motion_planning_msgs
 	   JointConstraint PoseConstraint KinematicConstraints
-	   KinematicSpaceParameters KinematicJoint KinematicState KinematicPath ]
-	  [manipulation_msgs.msg JointTrajPoint JointTraj IKRequest ]
-;	 [topological_map.msg Cell Connector ConnectorEdge MapRegion]
-	  [visualization_msgs.msg Polyline]
-	  [pr2_robot_actions.msg MoveArmGoal MoveArmState]
-	  [mechanism_msgs.msg JointState ActuatorState MechanismState]
-	  ])
-
-
-
-(defsrvs [ros.pkg
-	  [pr2_mechanism_controllers.srv TrajectoryStart TrajectoryQuery TrajectoryCancel]
-	  [motion_planning_srvs.srv MotionPlan]
-	  [manipulation_srvs.srv    IKService]
-	  [tf_node.srv              TransformPoint TransformPose]
-	  [navfn.srv SetCostmap MakeNavPlan]
-	  [fk_node.srv              ForwardKinematics]
-;	  [robot_srvs.srv StaticMap]
-;	  [topological_map.srv GetTopologicalMap]
-	  ])
+	   KinematicSpaceParameters KinematicJoint KinematicState KinematicPath]
+	  [manipulation_msgs JointTraj IKRequest]
+	  [pr2_robot_actions MoveArmGoal MoveArmState]
+	  [mechanism_msgs    MechanismState]
+	  )
+
+(defsrvs  [pr2_mechanism_controllers TrajectoryStart TrajectoryQuery TrajectoryCancel]
+	  [motion_planning_srvs MotionPlan]
+	  [manipulation_srvs    IKService]
+	  [tf_node              TransformPoint TransformPose]
+	  [navfn                SetCostmap MakeNavPlan]
+	  [fk_node              ForwardKinematics]
+	  )

@@ -850,7 +836,7 @@

 (comment
 (do (use 'ros.ros 'ros.world 'ros.robot :reload-all) (import-ros)
-(defmsgs [ros.pkg
+(defmsgs
 	  [roslib.msg Header]
 	  [std_msgs.msg ColorRGBA Float64]
 	  [robot_msgs.msg


Fix NPE when we get HTTP request withou Host header.

--- src/clj/hatnik/web/server/handler.clj
+++ src/clj/hatnik/web/server/handler.clj
@@ -42,7 +42,7 @@
                   :message "Not authenticated"}}))))

 (defn index-page [config req]
-  (if (.startsWith (-> req :headers (get "host")) "hatnik.clojurecup.com")
+  (if (.startsWith (-> req :headers (get "host" "")) "hatnik.clojurecup.com")
     ; Redirect all requests coming for hatnik.clojurecup.com to hatnik.com
     {:status 301
      :headers {"Location" "http://hatnik.com"}


Don't bomb on jline logging

Don't bomb on jline logging

--- src/clj/reply/reader/simple_jline.clj
+++ src/clj/reply/reader/simple_jline.clj
@@ -16,7 +16,6 @@
         (File. "." history-path)))
     (File. (System/getProperty "user.home") ".jline-reply.history")))

-
 (defn reset-reader [reader]
   (when reader
     (.clear (.getCursorBuffer reader))))
@@ -29,7 +28,7 @@

 (defn null-output-stream []
   (proxy [java.io.OutputStream] []
-    (write [b])))
+    (write [& args])))

 (defn- initialize-jline []
   (.addShutdownHook (Runtime/getRuntime)


comment

comment

--- src/cljs/omnext_routing_one/core.cljs
+++ src/cljs/omnext_routing_one/core.cljs
@@ -93,7 +93,8 @@

   static om/IQuery
   (query [_]
-         '[:tab-key/countries
+         '[:tab-key/countries ; XXX: this is crazy hack, which allows
+                              ; to determine active tab by it's query
            (:countries {:page ?page})]
          )


less ugly replacement for condp expression

--- src/cljs/phonecat_re_frame/views.cljs
+++ src/cljs/phonecat_re_frame/views.cljs
@@ -88,11 +88,11 @@
            ^{:key (:name attribute)} [:div
                                       [:dt (:name attribute)]
                                       [:dd (let [value (:value attribute)]
-                                             (condp #(%1 %2) value
-                                               true? "\u2713"
-                                               false? "\u2718"
-                                               vector? (clojure.string/join ", " value)
-                                               value))]])
+                                             (cond
+                                               (true? value) "\u2713"
+                                               (false? value) "\u2718"
+                                               (vector? value) (clojure.string/join ", " value)
+                                               :else value))]])
          attributes-map)]])

 (defn thumbnails


Adds support for files from classpath

Adds support for files from classpath

Will first look for a .catacumba file in the classpath and will
otherwise run without a basedir.

--- src/clojure/catacumba/impl/server.clj
+++ src/clojure/catacumba/impl/server.clj
@@ -78,7 +78,10 @@
         sslcontext (build-ssl-context keystore)
         config (if (string? basedir)
                  (ServerConfig/baseDir ^Path (utils/str->path basedir))
-                 (ServerConfig/noBaseDir))]
+                 (try
+                   (ServerConfig/findBaseDir ".catacumba")
+                   (catch RuntimeException e
+                     (ServerConfig/noBaseDir))))]
     (when sslcontext (.ssl config sslcontext))
     (when public-address (.publicAddress config (java.net.URI. public-address)))
     (when max-body-size (.maxContentLength config max-body-size))
@@ -108,7 +111,9 @@

   Additional notes:

-  - The `:basedir` is used mainly for resolve relative paths for assets.
+  - The `:basedir` is used mainly to resolve relative paths for assets. When you set
+    no basedir it first try to find a .catacumba file in the root of you classpath if
+    it cannot find that it will run without a basedir
   - With `:publicaddress` you can force one specific public address, in case contrary it
     will be discovered using a variety of different strategies explained in the
     `public-address` function docstring.


add support for continuous exec contexts, update signal fns to accept full vertex (not just state), add remove-vertex!, add triple graph sketch

--- src/thi/ng/fabric/async.cljc
+++ src/thi/ng/fabric/async.cljc
@@ -1,9 +1,12 @@
 (ns thi.ng.fabric.async
   (:require
    [clojure.core.async :as a :refer [go go-loop chan close! <! >! alts! timeout]]
-   [taoensso.timbre :refer [debug warn error]]))
+   [taoensso.timbre :refer [debug info warn error]]
+   [clojure.set :as set]))

 (taoensso.timbre/set-level! :warn)
+
+;;(warn :free-ram (.freeMemory (Runtime/getRuntime)))

 (defprotocol IVertex
   (connect-to! [_ v sig-fn edge-opts])
@@ -18,6 +21,7 @@

 (defprotocol IComputeGraph
   (add-vertex! [_ vstate])
+  (remove-vertex! [_ v])
   (vertex-for-id [_ id])
   (vertices [_]))

@@ -34,7 +38,7 @@
 (def default-collect (simple-collect into))

 (defn signal-forward
-  [state _] (::val state))
+  [vertex _] @vertex)

 (defn default-score-signal
   "Computes vertex signal score. Returns 0 if state's ::val
@@ -76,7 +80,7 @@
     _)
   (close-input! [_]
     (if @in
-      (do (debug (str id " closing..."))
+      (do #_(debug (str id " closing..."))
           (close! @in)
           (reset! in nil))
       (warn (str id " already closed")))
@@ -92,7 +96,7 @@
       (go-loop [outs @outs]
         (let [[v [f opts]] (first outs)]
           (when v
-            (let [signal (f state opts)]
+            (let [signal (f _ opts)]
               (if-not (nil? signal)
                 (>! (input-channel v) [id signal])
                 (warn (format "signal fn for %d returned nil, skipping..." (:id v)))))
@@ -125,7 +129,7 @@
   {:collect-thresh 0
    :signal-thresh  0
    :bus-size       16
-   :timeout        100
+   :timeout        25
    :max-ops        1e6})

 (defn vertex
@@ -151,6 +155,8 @@
                  (update :vertices assoc id v)
                  (assoc  :curr-vertex v)))))
         :curr-vertex))
+  (remove-vertex!
+    [_ v] (swap! state update :vertices dissoc (:id v)))
   (vertex-for-id
     [_ id] (get-in @state [:vertices id]))
   (vertices
@@ -160,9 +166,9 @@
   [] (Graph. (atom {:vertices {} :next-id 0})))

 (defn eager-vertex-processor
-  [{:keys [id state] :as vertex} ctx]
+  [{:keys [id] :as vertex} ctx]
   (let [{:keys [collect-thresh signal-thresh]} @ctx
-        in   (input-channel vertex)]
+        in (input-channel vertex)]
     (go-loop []
       (let [[src-id sig] (<! in)]
         (if sig
@@ -171,11 +177,12 @@
               (when (should-collect? vertex collect-thresh)
                 (notify ctx [:collect id])
                 (collect! vertex)
+                ;;(debug (format "%d post-collection: %s" id (pr-str @vertex)))
                 (when (should-signal? vertex signal-thresh)
                   (notify ctx [:signal id])
                   (signal! vertex)))
               (recur))
-          (debug (str id " stopped")))))
+          #_(debug (str id " stopped")))))
     vertex))

 (defn execution-result
@@ -227,8 +234,8 @@
                   (recur (next verts))))
               (loop [colls 0 sigs 0]
                 (if (<= (+ colls sigs) max-ops)
-                  (let [t (timeout max-t)
-                        [[evt v ex] port] (alts! (conj bus t))]
+                  (let [t (if max-t (timeout max-t))
+                        [[evt v ex] port] (alts! (if max-t (conj bus t) bus))]
                     (if (= port t)
                       (do (stop! _)
                           (execution-result :converged result colls sigs t0))
@@ -285,7 +292,7 @@
     :processor eager-vertex-processor}))

 (defn signal-sssp
-  [state dist] (if-let [v (::val state)] (+ dist v)))
+  [vertex dist] (if-let [v @vertex] (+ dist v)))

 (def collect-sssp
   (simple-collect
@@ -374,3 +381,113 @@
       (doseq [[a b] hierarchy]
         (connect-to! (verts a) (verts b) signal-forward nil))
       verts)))
+
+(defn signal-triple
+  [vertex _]
+  [(:id vertex) @vertex])
+
+(defn collect-index
+  [spo]
+  (simple-collect
+   (fn [val incoming]
+     (transduce
+      (map (fn [[id t]] [id (nth t spo)]))
+      (completing (fn [acc [id x]] (update acc x (fnil conj #{}) id)))
+      val incoming))))
+
+(defn index-vertex
+  [g spo]
+  (add-vertex! g {::val {}
+                  ::collect-fn (collect-index spo)
+                  ::score-signal-fn (constantly 1)}))
+
+(def s-idx (index-vertex g 0))
+(def p-idx (index-vertex g 1))
+(def o-idx (index-vertex g 2))
+
+(defn add-triple
+  [g t]
+  (let [v (add-vertex! g {::val t})]
+    (connect-to! v s-idx signal-triple nil)
+    (connect-to! v p-idx signal-triple nil)
+    (connect-to! v o-idx signal-triple nil)
+    (signal! v)
+    v))
+
+(defn signal-select
+  [vertex [idx sel]]
+  [idx (if sel (@vertex sel [nil]) (->> @vertex vals (eduction (mapcat identity))))])
+
+(def collect-select
+  (simple-collect
+   (fn [val incoming]
+     (reduce (fn [acc [idx res]] (update acc idx (fnil into #{}) res)) val incoming))))
+
+(def aggregate-select
+  (simple-collect
+   (fn [val incoming]
+     (let [res (vals (last incoming))]
+       ;;(info :res res)
+       (when (and (seq res) (every? #(not= #{nil} %) res))
+         (->> res
+              (map #(disj % nil))
+              (set)
+              (sort-by count)
+              ;;(#(do (info :sorted %) %))
+              (reduce set/intersection)
+              (map #(deref (vertex-for-id g %)))))))))
+
+;; TODO figure out way how to at to a running context
+(defn register-query
+  [g s p o]
+  (let [acc (add-vertex! g {::val {} ::collect-fn collect-select})
+        res (add-vertex! g {::val nil ::collect-fn aggregate-select})]
+    (connect-to! s-idx acc signal-select [0 s])
+    (connect-to! p-idx acc signal-select [1 p])
+    (connect-to! o-idx acc signal-select [2 o])
+    (connect-to! acc res signal-forward nil)
+    ;;[acc res]
+    res))
+
+#_(defn select
+  [g s p o]
+  (let [acc (add-vertex! g {::val {} ::collect-fn collect-select})
+        ctx (async-context
+             {:graph     g
+              :processor eager-vertex-processor})]
+    (connect-to! s-idx acc signal-select [0 s])
+    (connect-to! p-idx acc signal-select [1 p])
+    (connect-to! o-idx acc signal-select [2 o])
+    (info @(execute! ctx))
+    (disconnect-vertex! s-idx acc)
+    (disconnect-vertex! p-idx acc)
+    (disconnect-vertex! o-idx acc)
+    (remove-vertex! g acc)
+    (let [res (vals @acc)]
+      (info :res res)
+      (when-not (some #(= #{:void} %) res)
+        (->> res
+             (map #(disj % :void))
+             (set)
+             (sort-by count)
+             (#(do (info :sorted %) %))
+             (reduce set/intersection)
+             (map #(deref (vertex-for-id g %))))))))
+
+(def triples
+  (mapv
+   #(add-triple g %)
+   '[[toxi author fabric]
+     [fabric type project]
+     [toxi type person]]))
+
+(def ctx (async-context {:graph g :processor eager-vertex-processor :timeout nil}))
+(def toxi (register-query g 'toxi nil nil))
+(def types (register-query g nil 'type nil))
+(def projects (register-query g nil 'type 'project))
+
+(execute! ctx)
+
+;;(warn :free-ram (.freeMemory (Runtime/getRuntime)))
+
+;; TODO add TripleGraph w/ separate sets of triple, index, rule & query vertices


add scale-to-(width|height)-only routes

add scale-to-(width|height)-only routes

* scale-only-down was removed
* there are two separate resources for scaling down for weight and height

--- src/vignette/http/routes.clj
+++ src/vignette/http/routes.clj
@@ -76,7 +76,7 @@
                   :thumbnail-mode "scale-to-width"
                   :width size-regex}))

-(def scale-only-down-route
+(def scale-to-width-down-route
   (route-compile "/:wikia:image-type/:top-dir/:middle-dir/:original/revision/:revision/:thumbnail-mode/:width"
                  {:wikia wikia-regex
                   :image-type image-type-regex
@@ -84,8 +84,19 @@
                   :middle-dir middle-dir-regex
                   :original original-regex
                   :revision revision-regex
-                  :thumbnail-mode "scale-only-down"
+                  :thumbnail-mode "scale-to-width-down"
                   :width size-regex}))
+
+(def scale-to-height-down-route
+  (route-compile "/:wikia:image-type/:top-dir/:middle-dir/:original/revision/:revision/:thumbnail-mode/:height"
+                 {:wikia wikia-regex
+                  :image-type image-type-regex
+                  :top-dir top-dir-regex
+                  :middle-dir middle-dir-regex
+                  :original original-regex
+                  :revision revision-regex
+                  :thumbnail-mode "scale-to-width-down"
+                  :height size-regex}))

 (defn create-request-handlers
   "Creates request handlers for a given route for GET & HEAD using the given route and
@@ -108,6 +119,8 @@
   [system]
   (flatten
     [(create-request-handlers system scale-to-width-route handle-thumbnail route->thumbnail-auto-height-map)
+     (create-request-handlers system scale-to-width-down-route handle-thumbnail route->thumbnail-auto-height-map)
+     (create-request-handlers system scale-to-height-down-route handle-thumbnail route->thumbnail-auto-width-map)
      (create-request-handlers system window-crop-route handle-thumbnail route->thumbnail-auto-height-map)
      (create-request-handlers system window-crop-fixed-route handle-thumbnail route->thumbnail-map)
      (create-request-handlers system thumbnail-route handle-thumbnail route->thumbnail-map)


get rid of unused fields

get rid of unused fields

--- src/wishlistd/models/sql.clj
+++ src/wishlistd/models/sql.clj
@@ -66,8 +66,8 @@

 (defn update-wish [{:keys [id] :as w}]
   (update wish
-    (set-fields w)
     (where {:id id})))
+    (set-fields (dissoc w :wishlist_code :id))

 (defn delete-wish [id]
   (delete wish


Fix comment typo.

Fix comment typo.

--- src/oc/storage/async/notification.clj
+++ src/oc/storage/async/notification.clj
@@ -36,8 +36,8 @@
   "
   A trigger for one of the various types of notifications that are published:

-  add - the content in  newly created, this happens when a board or entry is added
-  update - the content-id should be refreshed, this happens when a board or entry is updated
+  add - the content is newly created, this happens when a board or entry is added
+  update - the content should be refreshed, this happens when a board or entry is updated
   delete - the specified content-id is deleted, this happens when a board or entry is removed

   The notification trigger contains the type of resource as `resource-type` and the content as `new` and/or


Remove extraneous print

Remove extraneous print

--- src/omchaya/controllers/controls.cljs
+++ src/omchaya/controllers/controls.cljs
@@ -20,7 +20,6 @@
   [target message args state]
   (let [old-channel    (get-in state [:channels (:selected-channel state)])
         new-channel    (get-in state [:channels args])]
-    (print "Switching to tab....")
     (-> state
         (assoc :selected-channel args)
         (assoc-in [:channels (:id old-channel) :selected] false)


test get-matches

test get-matches

--- test/foosball/test/db.clj
+++ test/foosball/test/db.clj
@@ -2,8 +2,11 @@
   (:require [foosball.models.db :refer :all]
             [com.stuartsierra.component :as c]
             [foosball.models.domains :as d]
+            [foosball.util :as util]
             [clojure.test :refer :all]
-            [taoensso.timbre :as t]))
+            [clojure.data :as data]
+            [taoensso.timbre :as t]
+            [clojure.pprint :refer [pprint]]))

 (defn memory-db []
   (c/start
@@ -15,9 +18,10 @@

 (use-fixtures :each log-fixture)

-(defn intersect-keys= [expected actual]
-  (let [keys-to-compare (keys expected)]
-    (= expected (select-keys actual keys-to-compare))))
+(defn diff-with-first-nil? [expected actual]
+  (let [diff (first (data/diff expected actual))]
+    (when diff (pprint {:diff diff}))
+    (= nil (first (data/diff expected actual)))))

 (defn make-uuid []
   (java.util.UUID/randomUUID))
@@ -45,18 +49,18 @@
                      :id id}] (d/get-players db))))

           (testing "we can get the player be his openid"
-            (is (intersect-keys= {:playername name
-                                  :playerid id} (d/get-player-with-given-openid db openid))))
+            (is (diff-with-first-nil? {:playername name
+                                       :playerid id} (d/get-player-with-given-openid db openid))))

           (testing "we can inactivate him,"
             (is (not= nil (d/deactivate-player! db id)))
             (testing "then he is inactive"
-              (is (intersect-keys= {:active false} (first (d/get-players db))))))
+              (is (diff-with-first-nil? {:active false} (first (d/get-players db))))))

           (testing "we can reactivate him,"
             (is (not= nil (d/activate-player! db id)))
             (testing "then he is active again"
-              (is (intersect-keys= {:active true} (first (d/get-players db))))))
+              (is (diff-with-first-nil? {:active true} (first (d/get-players db))))))
           (testing "we can rename our player,"
             (let [new-name "jeffrey"]
               (is (not= nil (d/rename-player! db id new-name)))
@@ -66,13 +70,26 @@
   (testing "Creating matches"
     (let [db            (memory-db)
           create-player (fn [seed]
-                          (let [id (make-uuid)]
-                            (d/create-player! db id (str "name" seed) (str "openid" seed))
-                            id))
+                          (let [id (make-uuid)
+                                name (str "name-" seed)
+                                openid (str "openid-" seed)]
+                            (d/create-player! db id name openid )
+                            (util/symbols-as-map id name openid)))
           [p1 p2 p3 p4] (map create-player ["p1" "p2" "p3" "p3"])
-          match-date (java.util.Date.)]
-      (testing "We can create a match with our four players"
+          match-date (java.util.Date.)
+          team1score 10
+          team2score 5
+          reporter (create-player "reporter")]
+      (testing "We can create a match with our four players,"
         (is (not= nil (d/create-match! db {:matchdate match-date
-                                           :team1 {:player1 p1 :player2 p2 :score 10}
-                                           :team2 {:player1 p3 :player2 p4 :score 5}
-                                           :reported-by p1})))))))
+                                           :team1 {:player1 (:id p1) :player2 (:id p2) :score team1score}
+                                           :team2 {:player1 (:id p3) :player2 (:id p4) :score team2score}
+                                           :reported-by (:id reporter)})))
+        (testing "then we can get it out again"
+          (let [result (d/get-matches db)]
+            (is (diff-with-first-nil? {:matchdate match-date
+                                       :team1 {:player1 (:name p1) :player2 (:name p2) :score team1score}
+                                       :team2 {:player1 (:name p3) :player2 (:name p4) :score team2score}
+                                       :reported-by (:name reporter)}
+                                      (first result)))
+            (is (= 1 (count result)))))))))


add optimized MultiFn invoke path

add optimized MultiFn invoke path

--- src/main/shadow/build/cljs_hacks.cljc
+++ src/main/shadow/build/cljs_hacks.cljc
@@ -901,6 +901,10 @@
           ;; dispatch to variadic helper fn
           :else
           (make-invoke :fn env form fexpr @args-exprs)))
+
+      ;; can always invoke multi-methods via ifn. don't need to check
+      (= 'cljs.core/MultiFn ftag)
+      (make-invoke :ifn env form fexpr @args-exprs)

       ;; fallback where something might be a function or IFn impl but we can't tell at compile time
       ;; need to wrap higher order calls to avoid repeating argument construction code


Assert database url exists before starting postgres

--- src/polismath/components/postgres.clj
+++ src/polismath/components/postgres.clj
@@ -49,14 +49,13 @@
     (query component (sql/format query-data))
     (jdbc/query (:db-spec component) query-data)))

-
-
 (defrecord Postgres [config db-spec]
   component/Lifecycle
   (start [component]
     (log/info ">> Starting Postgres component")
-    (let [db-spec (-> config :database :url heroku-db-spec)]
-      (assoc component :db-spec db-spec)))
+    (let [database-url (-> config :database :url)]
+      (assert database-url "Missing database url. Make sure to set env variables.")
+      (assoc component :db-spec (heroku-db-spec database-url))))
   (stop [component]
     (log/info "<< Stopping Postgres component")
     (assoc component :db-spec nil)))


Capture all task bundles and their keys in the information model.

--- src/onyx/kafka/information_model.cljc
+++ src/onyx/kafka/information_model.cljc
@@ -76,4 +76,26 @@
             {:doc "Do not write :done to the topic when task receives the sentinel signal (end of batch job)."
              :type :boolean
              :default false
-             :optional? true}}}})
+             :optional? true}}}
+
+   :task-bundles
+   {:kafka/read-messages
+    [:kafka/topic
+     :kafka/group-id
+     :kafka/zookeeper
+     :kafka/offset-reset
+     :kafka/force-reset?
+     :kafka/deserializer-fn
+     :kafka/partition
+     :kafka/chan-capacity
+     :kafka/fetch-size
+     :kafka/empty-read-back-off
+     :kafka/commit-interval
+     :kafka/wrap-with-metadata?]
+
+    :kafka/write-messages
+    [:kafka/topic
+     :kafka/zookeeper
+     :kafka/serializer-fn
+     :kafka/request-size
+     :kafka/no-seal?]}})


(PDB-5216) query->sql: simplify before making query-id universal

Rework query->sql to simplify it a bit in preparation for making the
query-id availble all the time, whether or not we log it.

Move the local sql conversion code into a separate regular-query->sql
function, and move the query logging inside query->sql.

--- src/puppetlabs/puppetdb/query_eng.clj
+++ src/puppetlabs/puppetdb/query_eng.clj
@@ -102,16 +102,44 @@
          :when (:queryable? projection-value)]
      (keyword projection-key))))

-(defn maybe-log-sql [options context gen-sql]
-  (if-let [log-id (:log-id context)]
-    (let [{[query & params] :results-query :as sql} (gen-sql)]
-      (log/infof "PDBQuery:%s:%s"
-                 log-id (-> (sorted-map :origin (:origin options)
-                                        :sql query
-                                        :params (vec params))
-                            json/generate-string))
-      sql)
-    (gen-sql)))
+(defn- regular-query->sql
+  [query entity options]
+  (let [query-rec (cond
+                    ;; Move this so that we always look for
+                    ;; include_facts_expiration (PDB-4586).
+                    (and (:include_facts_expiration options)
+                         (= entity :nodes))
+                    (get-in @entity-fn-idx [:nodes-with-fact-expiration :rec])
+
+                    (and (:include_package_inventory options)
+                         (= entity :factsets))
+                    (get-in @entity-fn-idx [:factsets-with-packages :rec])
+
+                    :else
+                    (get-in @entity-fn-idx [entity :rec]))
+        columns (orderable-columns query-rec)]
+    (paging/validate-order-by! columns options)
+    (if (:add-agent-report-filter options)
+      (let [ast (try
+                  (dr/maybe-add-agent-report-filter-to-query query-rec query)
+                  (catch ExceptionInfo e
+                    (let [data (ex-data e)
+                          msg (.getMessage e)]
+                      (when (not= ::dr/unrecognized-ast-syntax (:kind data))
+                        (log/error e (trs "Unknown exception when processing ast to add report type filter(s)."))
+                        (throw e))
+                      (log/error e msg)
+                      ::failed))
+                  (catch Exception e
+                    (log/error e (trs "Unknown exception when processing ast to add report type filter(s)."))
+                    (throw e)))]
+        (if (= ast ::failed)
+          (throw (ex-info "AST validation failed, but was successfully converted to SQL. Please file a PuppetDB ticket at https://tickets.puppetlabs.com"
+                          {:kind ::dr/unrecognized-ast-syntax
+                           :ast query
+                           :sql (eng/compile-user-query->sql query-rec query options)}))
+          (eng/compile-user-query->sql query-rec ast options)))
+      (eng/compile-user-query->sql query-rec query options))))

 (defn query->sql
   "Converts a vector-structured `query` to a corresponding SQL query which will
@@ -124,58 +152,25 @@
            (jdbc/valid-jdbc-query? (:results-query %))
            (or (not (:include_total options))
                (jdbc/valid-jdbc-query? (:count-query %)))]}
-
-   (maybe-log-sql
-    options
-    context
-    (fn []
-      (cond
-        (= :aggregate-event-counts entity)
-        (aggregate-event-counts/query->sql version query options)
-
-        (= :event-counts entity)
-        (event-counts/query->sql version query options)
-
-        (and (= :events entity) (:distinct_resources options))
-        (events/legacy-query->sql false version query options)
-
-        :else
-        (let [query-rec (cond
-                          ;; Move this so that we always look for
-                          ;; include_facts_expiration (PDB-4586).
-                          (and (:include_facts_expiration options)
-                               (= entity :nodes))
-                          (get-in @entity-fn-idx [:nodes-with-fact-expiration :rec])
-
-                          (and (:include_package_inventory options)
-                               (= entity :factsets))
-                          (get-in @entity-fn-idx [:factsets-with-packages :rec])
-
-                          :else
-                          (get-in @entity-fn-idx [entity :rec]))
-              columns (orderable-columns query-rec)]
-          (paging/validate-order-by! columns options)
-          (if (:add-agent-report-filter options)
-            (let [ast (try
-                        (dr/maybe-add-agent-report-filter-to-query query-rec query)
-                        (catch ExceptionInfo e
-                          (let [data (ex-data e)
-                                msg (.getMessage e)]
-                            (when (not= ::dr/unrecognized-ast-syntax (:kind data))
-                              (log/error e (trs "Unknown exception when processing ast to add report type filter(s)."))
-                              (throw e))
-                            (log/error e msg)
-                            ::failed))
-                        (catch Exception e
-                          (log/error e (trs "Unknown exception when processing ast to add report type filter(s)."))
-                          (throw e)))]
-              (if (= ast ::failed)
-                (throw (ex-info "AST validation failed, but was successfully converted to SQL. Please file a PuppetDB ticket at https://tickets.puppetlabs.com"
-                                {:kind ::dr/unrecognized-ast-syntax
-                                 :ast query
-                                 :sql (eng/compile-user-query->sql query-rec query options)}))
-                (eng/compile-user-query->sql query-rec ast options)))
-            (eng/compile-user-query->sql query-rec query options))))))))
+   (let [result (cond
+                  (= :aggregate-event-counts entity)
+                  (aggregate-event-counts/query->sql version query options)
+
+                  (= :event-counts entity)
+                  (event-counts/query->sql version query options)
+
+                  (and (= :events entity) (:distinct_resources options))
+                  (events/legacy-query->sql false version query options)
+
+                  :else (regular-query->sql query entity options))]
+     (when-let [log-id (:log-id context)]
+       (let [{[sql & params] :results-query} result]
+         (log/infof "PDBQuery:%s:%s"
+                    log-id (-> (sorted-map :origin (:origin options)
+                                           :sql sql
+                                           :params (vec params))
+                               json/generate-string))))
+     result)))

 (defn get-munge-fn
   [entity version paging-options url-prefix]


almost ready to try it out...

almost ready to try it out...

--- src/thinktopic/cortex/autoencoder.clj
+++ src/thinktopic/cortex/autoencoder.clj
@@ -9,6 +9,10 @@
 (defn sigmoid
   [z]
   (/ 1.0  (+ 1.0 (Math/exp (- z)))))
+
+(defn sigmoid-prime
+  [z]
+  (* (sigmoid z) (- 1 (sigmoid z))))

 ;; K-sparse autoencoder
 ;0) setup
@@ -64,8 +68,22 @@
 ;; Gradient descent

 (defn backprop
-  [{:keys [biases weights] :as net} input label]
-  )
+  [{:keys [biases weights layer-sizes] :as net} input label]
+  (let [bias-gradients (map #(mat/zero-array (mat/shape %)) biases)
+        weight-gradients (map #(mat/zero-array (mat/shape %)) weights)
+        [activations zs] (reduce
+                           (fn [[activations zs] [layer-biases layer-weights]]
+                             (let [z (mat/add (mat/mmul (last activations) layer-weights) layer-biases)
+                                   activation (sigmoid z)]
+                               [(conj activations activation) (conj zs z)]))
+                           [[input] []]
+                           (map vector biases weights))
+        cost-derivs (mat/sub (last activations) label)
+        output-deltas (mat/emul cost-derivs (mat/emap sigmoid-prime (last zs)))
+        output-bias-gradients output-deltas
+        output-weight-gradients (mat/mmul output-deltas (mat/transpose (last (drop-last activations))))
+        ]
+    ))

 (defn update-mini-batch


Remove unnecessary comment

Remove unnecessary comment

--- modules/template/src/modular/template.clj
+++ modules/template/src/modular/template.clj
@@ -12,12 +12,6 @@

 (defprotocol Templater
   (render-template [_ template model]))
-
-;; An issue with Template is that it is static, it is given
-;; the template as an argument. It is envisaged that other records,
-;; other than SingleTemplate, which will switch the template based on
-;; the request, can be developed. For now, if you have multiple
-;; templates, create a SingleTemplate record for each one.

 (defrecord Template [template]
   RingBinding


Polish tests

Polish tests

--- test/cljc/reitit/middleware_test.cljc
+++ test/cljc/reitit/middleware_test.cljc
@@ -105,6 +105,12 @@
             (dotimes [_ 10]
               (is (= :request (app :request))))))))))

+(defn create-app [router]
+  (let [h (middleware/middleware-handler router)]
+    (fn [path]
+      (if-let [f (h path)]
+        (f [])))))
+
 (deftest middleware-handler-test

   (testing "all paths should have a handler"
@@ -125,12 +131,7 @@
                      ["/ping" handler]
                      ["/admin" {:middleware [[mw :admin]]}
                       ["/ping" handler]]]])
-          ->app (fn [router]
-                  (let [h (middleware/middleware-handler router)]
-                    (fn [path]
-                      (if-let [f (h path)]
-                        (f [])))))
-          app (->app router)]
+          app (create-app router)]

       (testing "not found"
         (is (= nil (app "/favicon.ico"))))
@@ -152,7 +153,7 @@
                        ["/api" {:name ::api
                                 :middleware [mw1 mw2 mw3 mw2]
                                 :handler handler}])
-              app (->app router)]
+              app (create-app router)]

           (is (= [::mw1 ::mw3 :ok ::mw3 ::mw1] (app "/api")))