new: letter-frequency-distribution

new: letter-frequency-distribution

--- src/hangman/words.clj
+++ src/hangman/words.clj
@@ -11,8 +11,6 @@
   (:use     [print.foo]))

-
-
 (def +default-corpus-file+ "resources/words.txt")

@@ -50,10 +48,8 @@
                  (list (list word c -1))
                  (map #(conj (list c %) word) posns)))))
          [(tuple word :length (count word))
-          (tuple word :type   :WORD)]
-         )))
-
-;; (word-triples "abccddd")
+          (tuple word :type   :WORD)])))
+

 (defn word-collection-triples [coll]
   (r/fold clojure.set/union clojure.set/union
@@ -64,13 +60,6 @@
   (r/fold clojure.set/union clojure.set/union
     (mapv word-triples (words-from-file filename))))

-;; (util/run-and-measure-timing
-;;   (count (file-triples +default-corpus-file+)))
-;;
-;;  => {:response         4511728,
-;;      :start-time 1401197847802,
-;;      :end-time   1401197881150,
-;;      :time-taken         33348}

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Database Management
@@ -94,16 +83,81 @@
 ;; trivial to implement using the facilities we have created for parsing and
 ;; graph construction.  Primarily, these are responsible for atomic interaction
 ;; with global state, which is limited to only the single atom 'word-db'.
-;;
+;;;

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Hangman Queries
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+
+(defn word-letters [w]
+  (into (sorted-set) (seq w)))

 (defn words-of-length [g length]
   (set (map s (query g nil :length length))))

+
+(defn words-excluding-letter [g letter]
+  (set (map s (query g nil letter -1))))
+
+(defn words-excluding [g & letters]
+  (apply clojure.set/intersection
+    (filter identity
+      (map (partial words-excluding-letter g) letters))))
+
+(defn words-with-letter-position [g letter position]
+  (set (map s (query g nil letter position))))
+
+(defn all-words [g]
+  (mapv s (query g nil :type :WORD)))
+
+(defn random-element [coll]
+  (nth (vec coll) (rand-int (count coll))))
+
+(defn random-word [g]
+  (random-element (all-words g)))
+
+(defn random-words [g n]
+  (loop [words #{} all (all-words g)]
+    (if (= (count words) n)
+      words
+      (recur (conj words (random-element all)) all))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Letter Frequency Distribution
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn letter-frequency-distribution [words]
+  (with-local-vars [newspace (transient {})]
+    (doseq [w words]
+      (doseq [t (word-letters w)]
+        (var-set newspace
+          (conj! (var-get newspace)
+            [t (inc (get (var-get newspace) t 0))]))))
+    (persistent! (var-get newspace))))
+
+
+(defn pp-letter-frequency-distribution
+  ([]      (pp-letter-frequency-distribution (all-words @word-db)))
+  ([words] (let [cols ["Term" "Words Occurred" "%"]
+                 tot  (count words)]
+             (pp/print-table cols
+               (map (partial zipmap cols)
+                 (sort-by second >
+                   (map #(conj % (pp/cl-format nil "~6,2f" (/ (second %)
+                                                             tot 0.01)))
+                     (seq (letter-frequency-distribution words)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Examples
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (word-triples "abccddd")
+
+;; (util/run-and-measure-timing
+;;   (count (word-file-triples +default-corpus-file+)))

 ;; (util/run-and-measure-timing
 ;;   (words-of-length @word-db 2))
@@ -119,34 +173,6 @@
 ;;        :start-time 1401743282516,
 ;;        :end-time   1401743282516,
 ;;        :time-taken 0}
-
-(defn words-excluding-letter [g letter]
-  (set (map s (query g nil letter -1))))
-
-(defn words-excluding [g & letters]
-  (apply clojure.set/intersection
-    (filter identity
-      (map (partial words-excluding-letter g) letters))))
-
-(defn words-with-letter-position [g letter position]
-  (set (map s (query g nil letter position))))
-
-(defn all-words [g]
-  (mapv s (query g nil :type :WORD)))
-
-(defn random-element [coll]
-  (nth coll (rand-int (count coll))))
-
-(defn random-word [g]
-  (random-element (all-words g)))
-
-(defn random-words [g n]
-  (loop [words #{} all (all-words g)]
-    (if (= (count words) n)
-      words
-      (recur (conj words (random-element all)) all))))
-
-

 ;; (util/run-and-measure-timing
@@ -208,4 +234,34 @@
 ;;      :time-taken 654}

-
+;; (util/run-and-measure-timing
+;;   (pp-letter-frequency-distribution))
+;;
+;; | Term | Words Occurred |      % |
+;; |------+----------------+--------|
+;; |    E |         121433 |  69.98 |
+;; |    S |         104351 |  60.13 |
+;; |    I |         102392 |  59.01 |
+;; |    A |          94264 |  54.32 |
+;; |    R |          91066 |  52.48 |
+;; |    N |          84485 |  48.69 |
+;; |    T |          83631 |  48.19 |
+;; |    O |          79663 |  45.91 |
+;; |    L |          68795 |  39.64 |
+;; |    C |          55344 |  31.89 |
+;; |    D |          47219 |  27.21 |
+;; |    U |          46733 |  26.93 |
+;; |    P |          40740 |  23.48 |
+;; |    M |          39869 |  22.98 |
+;; |    G |          38262 |  22.05 |
+;; |    H |          33656 |  19.40 |
+;; |    B |          26736 |  15.41 |
+;; |    Y |          24540 |  14.14 |
+;; |    F |          17358 |  10.00 |
+;; |    V |          14844 |   8.55 |
+;; |    K |          12757 |   7.35 |
+;; |    W |          11310 |   6.52 |
+;; |    Z |           7079 |   4.08 |
+;; |    X |           4607 |   2.65 |
+;; |    Q |           2541 |   1.46 |
+;; |    J |           2467 |   1.42 |


cjl - Fix syntax error

cjl - Fix syntax error

--- src/icfp2015/unit.clj
+++ src/icfp2015/unit.clj
@@ -18,7 +18,7 @@

 (defn rotate
   "Rotate a unit around a pivot point"
-  [rotation, {:keys pi pj :as pivot}]
+  [rotation, {:keys [pi pj] :as pivot}]
   nil)

 (def rotations


tiny refactor

tiny refactor

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -318,9 +318,9 @@
          (js/setTimeout
           #(let [plugins' (:plugins opts) ;; plugins replaces all plugins
                  merge-plugins (:merge-plugins opts) ;; merges plugins
-                 system-options (handle-deprecated-jsload-callback
-                                 (merge config-defaults
-                                        (dissoc opts :plugins :merge-plugins)))
+                 system-options (-> config-defaults
+                                  (merge (dissoc opts :plugins :merge-plugins))
+                                  (handle-deprecated-jsload-callback))
                  plugins  (if plugins'
                             plugins'
                             (merge (base-plugins system-options) merge-plugins))]


Change prefix into avow to full var name.

--- src/incise/config.clj
+++ src/incise/config.clj
@@ -22,7 +22,7 @@
   "Throws an AssertionError unless the given config map, or @config if not
   supplied, has no faults."
   [& [given-config]]
-  (avow! 'config validations (or given-config @config)))
+  (avow! 'incise.config/config validations (or given-config @config)))

 (defn get [& more]
   (avow-config!)


Clean up test.

Clean up test.

--- test/onyx/peer/fn_grouping_test.clj
+++ test/onyx/peer/fn_grouping_test.clj
@@ -1,7 +1,5 @@
 (ns onyx.peer.fn-grouping-test
-  (:require [com.stuartsierra.component :as component]
-            [onyx.system :refer [onyx-development-env]]
-            [onyx.peer.task-lifecycle-extensions :as l-ext]
+  (:require [onyx.peer.task-lifecycle-extensions :as l-ext]
             [taoensso.timbre :refer [info]]
             [midje.sweet :refer :all]
             [onyx.queue.hornetq-utils :as hq-util]
@@ -179,3 +177,4 @@
       (count (into #{} (filter identity (mapcat keys out-val)))))

 (fact results => [:done])
+


Typo in docstring

Typo in docstring

--- src/io/aviso/rook.clj
+++ src/io/aviso/rook.clj
@@ -191,7 +191,7 @@

 (defn rook-handler
   "Handler that uses information from :rook entry in the request map to invoke the previously
-  identified functionm, after resolving the function's arguments."
+  identified function, after resolving the function's arguments."
   [request]
   (let [rook-data (-> request :rook)
         arg-resolvers (concat (-> rook-data :default-arg-resolvers)


Fix author-email

Fix author-email

--- src/io/perun/atom.clj
+++ src/io/perun/atom.clj
@@ -33,7 +33,7 @@
        [:id base-url]
        (for [{:keys [uuid canonical-url content name author author-email] :as post} (take 10 posts)
              :let [author (or author (:name (:author global-metadata)))
-                   author-email (or author (:email (:author global-metadata)))]]
+                   author-email (or author-email (:email (:author global-metadata)))]]
          (do
            (assert (seq uuid) (format "Atom XML requires that each post has a unique uuid, if you need one, use this: %s" (str (java.util.UUID/randomUUID))))
            (assert (seq author) (format "Atom XML requires that each post has author name."))


class the right div

class the right div

--- src/io/perun/site.clj
+++ src/io/perun/site.clj
@@ -158,10 +158,10 @@

 (defn guide-page [{global-meta :meta post :entry}]
   (with-top-nav
-    [:div.guide
+    [:div
      [:h1.dib.ma0.pr2 (:title post)]
      [:a.no-underline {:href (edit-link post)} "edit"]]
-    [:div.md (:content post)]))
+    [:div.md.guide (:content post)]))

 (defn guides [{global-meta :meta guides :entries}]
   (with-top-nav


small change for next release

small change for next release

--- src/testapp/other.clj
+++ src/testapp/other.clj
@@ -45,7 +45,7 @@
 ; take-while on processed and sorted data- makes sense. performance wise...
 ; some - when we just need to check if at least one element for the collection satisfies one condition
 ; sort and sort-by
-; small change
+; small change, another change

 (reduce (fn [new-map [key val]]


fix bug in options merge logic

fix bug in options merge logic

--- src/transit/core.cljs
+++ src/transit/core.cljs
@@ -8,7 +8,7 @@

 (defn opts-merge [a b]
   (doseq [k (js-keys b)]
-    (when-let [v (aget b k)]
+    (let [v (aget b k)]
       (if (not= k "handlers")
         (aset a k v)
         (aset a k (.concat (aget a k) (aget b k))))))


add tasks method

add tasks method

--- src/hivewing_core/worker_config.clj
+++ src/hivewing_core/worker_config.clj
@@ -53,6 +53,12 @@
       ;;result)
     (catch clojure.lang.ExceptionInfo e false)))

+(defn worker-config-get-tasks
+  "Get the tasks for this worker"
+  [worker-uuid]
+  (get (worker-config-get worker-uuid :include-system-keys true) ".tasks"))
+
+
 (defn worker-config-delete
   "Deletes all the keys and such for a given worker. The worker was deleted
   so we should delete!"


Improved healthcheck to avoid JSON parsing error-message in browser.

--- src/tyranitar/web.clj
+++ src/tyranitar/web.clj
@@ -88,8 +88,8 @@
             [] applications-routes))

   (GET "/healthcheck" []
-       (response "" json-content-type 200))
-
+       (response "I am healthy. Thank you for asking." "text/plain;charset=utf-8"))
+
   (route/not-found (error-response "Resource not found" 404)))

 (def app


CLJS-1337: Move parse ns side-effects into a separate compiler pass

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -1882,32 +1882,7 @@
                 (map (spec-parsers k)
                   (remove #{:reload :reload-all} libs))))
             {} (remove (fn [[r]] (= r :refer-clojure)) args))]
-      (when (and *analyze-deps* (seq @deps))
-        #?(:clj (analyze-deps name @deps env (dissoc opts :macros-ns))))
-      (when (and *analyze-deps* (seq uses))
-        (check-uses uses env))
       (set! *cljs-ns* name)
-      #?(:clj
-         (when *load-macros*
-           (load-core)
-           (doseq [nsym (vals use-macros)]
-             (let [k (or (:use-macros @reload)
-                         (get-in @reloads [:use-macros nsym])
-                         (and (= nsym name) *reload-macros* :reload))]
-               (if k
-                 (clojure.core/require nsym k)
-                 (clojure.core/require nsym))
-               (intern-macros nsym k)))
-           (doseq [nsym (vals require-macros)]
-             (let [k (or (:require-macros @reload)
-                         (get-in @reloads [:require-macros nsym])
-                         (and (= nsym name) *reload-macros* :reload))]
-               (if k
-                 (clojure.core/require nsym k)
-                 (clojure.core/require nsym))
-               (intern-macros nsym k)))
-           (when (seq use-macros)
-             (check-use-macros use-macros env))))
       (let [ns-info
             {:name           name
              :doc            (or docstring mdocstr)
@@ -1916,17 +1891,15 @@
              :require-macros require-macros
              :uses           uses
              :requires       requires
-             :imports        imports
-             :deps           @deps
-             :reload         @reload
-             :reloads        @reloads}
+             :imports        imports}
             ns-info
             (if (:merge form-meta)
               ;; for merging information in via require usage in REPLs
               (let [ns-info' (get-in @env/*compiler* [::namespaces name])]
                 (if (pos? (count ns-info'))
                   (let [merge-keys
-                        [:use-macros :require-macros :uses :requires :imports]]
+                        [:name :doc :excludes :use-macros :require-macros
+                         :uses :requires :imports]]
                     (merge
                       ns-info'
                       (merge-with merge
@@ -1935,7 +1908,11 @@
                   ns-info))
               ns-info)]
         (swap! env/*compiler* update-in [::namespaces name] merge ns-info)
-        (merge {:op :ns :env env :form form
+        (merge {:op      :ns
+                :env     env
+                :form    form
+                :deps    @deps
+                :reload  @reload
                 :reloads @reloads}
           (cond-> ns-info
             (@reload :use)
@@ -2456,9 +2433,11 @@
 (defn ns-side-effects
   [env {:keys [op] :as ast} opts]
   (if (= :ns op)
-    (let [{:keys [deps require-macros use-macros reload reloads]} ast]
+    (let [{:keys [deps uses require-macros use-macros reload reloads]} ast]
       (when (and *analyze-deps* (seq deps))
         (analyze-deps name deps env (dissoc opts :macros-ns)))
+      (when (and *analyze-deps* (seq uses))
+        (check-uses uses env))
       (when *load-macros*
         (load-core)
         (doseq [nsym (vals use-macros)]
@@ -2529,7 +2508,9 @@

 (defn analyze* [env form name opts]
   (let [passes *passes*
-        passes (when (nil? passes) [infer-type])
+        passes (when (nil? passes)
+                 #?(:clj  [infer-type ns-side-effects]
+                    :cljs [infer-type]))
         form   (if (instance? LazySeq form)
                  (if (seq form) form ())
                  form)


add missing requires

add missing requires

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/util/kahn.cljs
+++ src/lt/util/kahn.cljs
@@ -1,4 +1,5 @@
-(ns lt.util.kahn)
+(ns lt.util.kahn
+  (:require [clojure.set :as set :refer [difference union intersection]]))

 (defn without
   "Returns set s with x removed."


Comment typo.

Comment typo.

--- src/open_company/resources/company.clj
+++ src/open_company/resources/company.clj
@@ -58,7 +58,7 @@
     (let [category-name (common/category-for section-name)] ; get the category for this section name
       (update-in sections [category-name] conj section-name)))) ; add the section name to the category

-;; ----- Slug -----
+;; ----- Company Slug -----

 (declare list-companies)
 (defn taken-slugs []
@@ -128,7 +128,7 @@

 (s/defn add-updated-at
   "Add `:updated-at` key with `ts` as value to a given section.
-   If the sectino has a `:notes` key also add the timestamp there."
+   If the section has a `:notes` key also add the timestamp there."
   [{:keys [section-name] :as section} :- common/Section ts]
   (let [notes-section? (contains? common/notes-sections section-name)]
     (cond-> (assoc section :updated-at ts)


Minot cosmetic fix on return values.

Minot cosmetic fix on return values.

--- src/uxbox/shapes.cljs
+++ src/uxbox/shapes.cljs
@@ -120,10 +120,11 @@
         final-y (- center-y d1)
         final-width (* d2 2)
         final-height (* d1 2)]
-    {:x final-x
-     :y final-y
-     :width final-width
-     :height final-height}))
+    (merge shape
+           {:x final-x
+            :y final-y
+            :width final-width
+            :height final-height})))

 (defn group-size-and-position
   "Given a collection of shapes, calculates the


[#242] Revert change in project.clj

[#242] Revert change in project.clj

- We do have a nREPL server as part of the project :/

--- api/project.clj
+++ api/project.clj
@@ -33,6 +33,7 @@
                  [com.google.cloud.sql/postgres-socket-factory "1.0.16"]
                  [clj-http "2.3.0"]
                  [cheshire "5.7.0"]
+                 [nrepl/nrepl "0.6.0"]
                  [com.taoensso/timbre "4.10.0"]
                  [com.fzakaria/slf4j-timbre "0.3.8" :exclusions [org.slf4j/slf4j-jdk14]]
                  [org.slf4j/slf4j-api "1.7.14"]


fix call to (show-bolt)

fix call to (show-bolt)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -110,7 +110,7 @@
       (add-all-comps-with-paths
        (lazy-mapcat
         (fn [bolt]
-          (log/info (str "add-all-comps-with-paths: " (show-bolt bolt path language-model)
+          (log/trace (str "add-all-comps-with-paths: " (show-bolt bolt language-model)
                           "@[" (string/join " " path) "]" "^" total-depth))
           (add-complement-to-bolt bolt path
                                   language-model (+ total-depth (count path))


remove (take)s and digging in to find source of eagerness to eliminate it

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -110,30 +110,29 @@
   (mapfn #(do-defaults % model)
          (let [comp-paths (find-comp-paths bolt-at)
                comp-bolts
-               (mapfn #(take take-n (comp-path-to-bolts bolt-at % model (+ 1 depth) max-depth))
+               (mapfn #(comp-path-to-bolts bolt-at % model (+ 1 depth) max-depth)
                       comp-paths)]
            (log/trace (str "add-bolt-at:" ((:morph-ps model) bolt-at) "; comp-paths: " (string/join "," comp-paths)))
            (when (not (some empty? comp-bolts))
-             (take take-n
-                   (filter #(not (= :fail %))
-                           (mapfn #(let [assoc (if (empty? path) %
-                                                   (assoc-in bolt path %))]
-                                     assoc)
-                                  (filter (fn [with-comps]
-                                            (do
-                                              (log/debug (str "add-bolt-at: added all comps to bolt: '" ((:morph model)
-                                                                                with-comps)
-                                                              "'"))
-                                              with-comps))
-                                          (add-comps bolt-at
-                                                     model
-                                                     comp-paths
-                                                     comp-bolts
-                                                     (+ 1 depth)
-                                                     max-depth
-                                                     top-bolt
-                                                     truncate?
-                                                     take-n)))))))))
+             (filter #(not (= :fail %))
+                     (mapfn #(let [assoc (if (empty? path) %
+                                             (assoc-in bolt path %))]
+                               assoc)
+                            (filter (fn [with-comps]
+                                      (do
+                                        (log/debug (str "add-bolt-at: added all comps to bolt: '" ((:morph model)
+                                                                                with-comps)
+                                                        "'"))
+                                        with-comps))
+                                    (add-comps bolt-at
+                                               model
+                                               comp-paths
+                                               comp-bolts
+                                               (+ 1 depth)
+                                               max-depth
+                                               top-bolt
+                                               truncate?
+                                               take-n))))))))
 (defn generate
   "Return one (by default) or _n_ (using :take _n_) expressions matching spec _spec_ given the model _model_."
   [spec language-model


Changing integration tests to get port value from env vars.

--- int_test/cmr/index_set/int_test/utility.clj
+++ int_test/cmr/index_set/int_test/utility.clj
@@ -8,13 +8,11 @@
             [clojure.data.codec.base64 :as b64]
             [cheshire.core :as cheshire]
             [clojurewerkz.elastisch.rest :as esr]
-            [cmr.elastic-utils.config :as es-config]))
-
-;;; index-set app enpoint
-(def port 3005)
+            [cmr.elastic-utils.config :as es-config]
+            [cmr.transmit.config :as transmit-config]))

 (def index-set-root-url
-  (format "%s:%s"  "http://localhost" port))
+  (format "%s:%s"  "http://localhost" (transmit-config/index-set-port)))

 ;; url applicable to create, get and delete index-set
 (def index-set-url


redirect for things on the blacklist

redirect for things on the blacklist

--- src/pc/http/handlers/custom_domain.clj
+++ src/pc/http/handlers/custom_domain.clj
@@ -4,7 +4,6 @@
             [pc.models.team :as team-model]
             [pc.profile :as profile]))

-;; XXX: redirect for things on the protected list
 (def blacklist #{"www" "admin"})

 ;; starts with a letter, only contains letters, numbers, and hyphens
@@ -24,7 +23,6 @@
                                             :query (:query-string req)}))}
    :body ""})

-;; XXX: redirect for things that don't match the pattern and aren't (profile/hostname)
 (defn handle-custom-domains [handler req]
   (let [subdomain (parse-subdomain req)]
     (if-not subdomain
@@ -32,9 +30,11 @@
                 (profile/hostname))
         (redirect-to-main req)
         (handler req))
-      (handler (assoc req
-                      :subdomain subdomain
-                      :team (team-model/find-by-subdomain (pcd/default-db) subdomain))))))
+      (if (contains? blacklist subdomain)
+        (redirect-to-main subdomain)
+        (handler (assoc req
+                        :subdomain subdomain
+                        :team (team-model/find-by-subdomain (pcd/default-db) subdomain)))))))

 (defn wrap-custom-domains [handler]
   (fn [req]


Add tests for regexes

Add tests for regexes

Asserting that each regex has the correct number of matching groups.

--- test/comic_reader/sites_test.clj
+++ test/comic_reader/sites_test.clj
@@ -75,6 +75,18 @@
 (defn comic-list-html []
   (when-let [image-resource (site-test-resource "comic_list.html")]
     (html/html-resource image-resource)))
+
+(defn num-groups [regex]
+  (-> regex
+      (.matcher "")
+      (.groupCount)))
+
+(defn test-regexes []
+  (and
+   (is (= 1 (num-groups (manga-pattern))))
+   (is (= 1 (num-groups (chapter-number-match-pattern))))
+   (is (= 0 (num-groups (page-normalize-pattern))))
+   (is (= 0 (num-groups (chapter-number-pattern))))))

 (defn valid-selector? [selector]
   (and
@@ -207,6 +219,7 @@
        (call-with-options
         ((get-sites) site-name)
         #(and
+          (test-regexes)
           (test-enlive-selectors)
           (if (has-test-folder?)
             (and


added docstrings

added docstrings

--- src/push/types/standard/vectorized.clj
+++ src/push/types/standard/vectorized.clj
@@ -30,7 +30,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-butlast` pops the top `" typename "` item and pushes the same vector lacking its last item (or nothing, if it ends up empty).")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(butlast %1) :as :most)
@@ -43,7 +43,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-concat` pops the top two `" typename "` items and pushes the the concatenation of the top one onto the second one.")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg2)
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
@@ -58,7 +58,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-conj` pops the top `" typename "` item and the top `" rootname "` item, and appends the latter to the former, pushing the result.")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~rootname :as :arg2)
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
@@ -73,7 +73,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-first` pops the top `" typename "` item and pushes the first element to the `" rootname "` stack (or nothing, if it's empty).")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(first %1) :as :top)
@@ -86,7 +86,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-last` pops the top `" typename "` item and pushes the last element to the `" rootname "` stack (or nothing, if it's empty).")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(last %1) :as :tail)
@@ -99,7 +99,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-length` pops the top `" typename "` item and pushes its count to the `:integer` stack.")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(count %1) :as :len)
@@ -112,7 +112,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-rest` pops the top `" typename "` item and pushes a vector containing all but the first element to the `" typename "` stack (or an empty vector, if it's empty; NOTE difference from `first` and others).")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(into [] (rest %1)) :as :end)
@@ -125,7 +125,7 @@
     (eval (list
       'push.instructions.core/build-instruction
       instruction-name
-      "DOCSTRING"
+      (str "`" typename "-first` pops the top `" typename "` item and pushes the reversed vector to the `" typename "` stack.")
       :tags #{:vector}
       `(push.instructions.dsl/consume-top-of ~typename :as :arg1)
       '(push.instructions.dsl/calculate [:arg1] #(reverse %1) :as :bw)


Fix error in navigation-3d.

Fix error in navigation-3d.

--- src/quil/middlewares/navigation_3d.clj
+++ src/quil/middlewares/navigation_3d.clj
@@ -132,7 +132,7 @@
   [user-setup user-settings]
   (let [initial-state (-> user-settings
                           (select-keys [:straight :up :position])
-                          (->> (merge (default-camera)))
+                          (->> (merge (default-position)))
                           (update-in [:straight] v-normalize)
                           (update-in [:up] v-normalize))]
     (update-in (user-setup) [:navigation-3d]


Deterministic script reload order.

Deterministic script reload order.

Use `jsloader/loadMany` on an array of the script URIs.

This guarantees the order of loading, so any dependencies
for each namespace will be reloaded first.

--- src/adzerk/boot_reload/reload.cljs
+++ src/adzerk/boot_reload/reload.cljs
@@ -41,10 +41,10 @@
                            :or {on-jsload identity}}]
   (let [js-files (filter #(ends-with? % ".js") changed)]
     (when (seq js-files)
-      (-> #(-> % guri/parse .makeUnique jsloader/load)
+      (-> #(-> % guri/parse .makeUnique)
         (map js-files)
         clj->js
-        deferred-list/gatherResults
+        (jsloader/loadMany)
         (.addCallbacks
           (fn [& _] (on-jsload))
           (fn [e] (.error js/console "Load failed:" (.-message e)))))


small tweak to unit test to avoid random failures.

--- test/metabase/api/table_test.clj
+++ test/metabase/api/table_test.clj
@@ -53,6 +53,7 @@
                                 :rows                100
                                 :id                  (id :venues)}])))))
   (->> ((user->client :rasta) :get 200 "table")
+       (filter #(= (:db_id %) (id)))                        ; prevent stray tables from affecting unit test results
        (map #(dissoc % :db :created_at :updated_at :schema :entity_name :description :entity_type :visibility_type))
        set))


More long line splitting in net.

More long line splitting in net.

--- src/cbfg/world/net.cljs
+++ src/cbfg/world/net.cljs
@@ -17,6 +17,7 @@
                               cbfg.world.lane/make-fenced-pump-lane)
     (act-loop fenced-pump-lane-in actx [num-ins 0]
               (let [msg (atake fenced-pump-lane-in server-recv-ch)]
+                (println :fenced-pump-lane-in msg)
                 (aput fenced-pump-lane-in fenced-pump-lane-in-ch msg)
                 (when (> (:sleep msg) 0)
                   (let [sleep-ch (atimeout fenced-pump-lane-in (:sleep msg))]
@@ -41,11 +42,13 @@
   (let [cmd-ch (achan actx)]
     (act client-loop actx
          (let [connect-result-ch (achan client-loop)]
-           (aput client-loop connect-ch [server-addr server-port client-addr connect-result-ch])
+           (aput client-loop connect-ch [server-addr server-port
+                                         client-addr connect-result-ch])
            (when-let [[client-send-ch client-recv-ch close-client-recv-ch]
                       (atake client-loop connect-result-ch)]
              (act-loop client-loop-in actx [num-ins 0]
                        (when-let [msg (atake client-loop-in cmd-ch)]
+                         (println :client-loop-in-msg msg)
                          (aput client-loop-in client-send-ch [msg])
                          (recur (inc num-ins))))
              (act-loop client-loop-out actx [num-outs 0]
@@ -55,7 +58,8 @@
     cmd-ch))

 (defn render-msg [msg class-extra style-extra]
-  ["
●"
+  ["
●"
    "
" (:result msg) "

"])

 (defn render-msgs [curr-msgs prev-msgs dist line-height]
@@ -77,7 +81,9 @@
               (rest prev-msgs)
               moving
               (conj out (render-msg prev-msg "msg-exit"
-                                    ["top:" (max 40 (- dist (* line-height (count out)) 70)) "px;"])))
+                                    ["top:" (max 40 (- dist (* line-height
+                                                               (count out)) 70))
+                                     "px;"])))
        :else
        (recur (rest curr-msgs)
               prev-msgs
@@ -97,23 +103,29 @@
         (swap! addrs #(assoc-in % [(:client-addr stream) :outs
                                    [(:accept-addr stream) (:accept-port stream)]
                                    [(:client-port stream)
-                                    (:server-addr stream) (:server-port stream)]] (:msgs stream)))
+                                    (:server-addr stream) (:server-port stream)]]
+                                (:msgs stream)))
         (swap! addrs #(assoc-in % [(:server-addr stream) :outs
                                    [(:accept-addr stream) (:accept-port stream)]
                                    [(:server-port stream)
-                                    (:client-addr stream) (:client-port stream)]] (:msgs stream)))))
+                                    (:client-addr stream) (:client-port stream)]]
+                                (:msgs stream)))))
     (let [naddrs (count @addrs) ; Assign coords.
           conns (sort (mapcat (fn [[addr addr-v]]
-                                (mapcat (fn [[[accept-addr accept-port] accept-addr-port-v]]
+                                (mapcat (fn [[[accept-addr accept-port]
+                                              accept-addr-port-v]]
                                           (map (fn [[[from-port to-addr to-port] msgs]]
                                                  [(not= addr accept-addr)
-                                                  addr accept-addr accept-port from-port])
+                                                  addr accept-addr accept-port
+                                                  from-port])
                                                accept-addr-port-v))
                                         (:outs addr-v)))
                               @addrs))]
       (doall (map-indexed (fn [addr-idx [addr addr-v]]
-                            (swap! coords #(assoc % addr
-                                                  [addr-idx (rem (* (dec naddrs) addr-idx) naddrs)])))
+                            (swap! coords
+                                   #(assoc % addr
+                                           [addr-idx (rem (* (dec naddrs) addr-idx)
+                                                          naddrs)])))
               (sort-by first @addrs)))
       (reduce (fn [prev [is-client addr accept-addr accept-port port]]
                 (let [idx (if (= (first prev) addr) (second prev) 0)]
@@ -128,7 +140,8 @@
           calc-xy (fn [addr] (let [[c0 c1] (get coords addr)]
                                [(* addr-width c0 (/ (+ addr-width addr-gap) addr-width))
                                 (* top-height c1)]))
-          h ["
"
+          h ["
"
              (mapv (fn [[addr addr-v]]
                      (let [[addr-x addr-y] (calc-xy addr)]
                        ["
"
@@ -140,37 +153,47 @@
                                  (when (and (= accept-addr addr)
                                             (get (:listens addr-v) accept-port))
                                    ["
" accept-port "
"])
-                                 (mapv (fn [[[from-port to-addr to-port] msgs]]
-                                         (let [from-x addr-x
-                                               from-y (+ addr-y (* line-height (get coords [addr from-port])))
-                                               [to-addr-x to-addr-y] (calc-xy to-addr)
-                                               to-x to-addr-x
-                                               to-y (+ to-addr-y (* line-height (get coords [to-addr to-port])))
-                                               dx (- from-x to-x)
-                                               dy (- to-y from-y)
-                                               rad (Math/atan2 dx dy)
-                                               dist (Math/abs (Math/sqrt (+ (* dx dx) (* dy dy))))
-                                               prev-msgs (get-in @prev-addrs [addr :outs
-                                                                              [accept-addr accept-port]
-                                                                              [from-port to-addr to-port]])]
-                                           ["
"
-                                            "
" from-port " --> " to-addr ":" to-port "
"
-                                            "
"
-                                            "  <div class='msgs"
-                                            (when (= accept-addr addr)
-                                              " to-client")
-                                            "' style='min-height:" (- dist 60) "px;"
-                                            "transform-origin:top left;"
-                                            "-ms-transform-origin:top left;"
-                                            "-webkit-transform-origin:top left;"
-                                            "transform:rotate(" rad "rad);"
-                                            "-ms-transform:rotate(" rad "rad);"
-                                            "-webkit-transform:rotate(" rad "rad);'>"
-                                            (render-msgs msgs prev-msgs dist line-height)
-                                            "
"
-                                            "
"
-                                            "
"]))
-                                       (sort-by first accept-addr-port-v))
+                                 (mapv
+                                  (fn [[[from-port to-addr to-port] msgs]]
+                                    (let [from-x addr-x
+                                          from-y (+ addr-y
+                                                    (* line-height
+                                                       (get coords [addr from-port])))
+                                          [to-addr-x to-addr-y] (calc-xy to-addr)
+                                          to-x to-addr-x
+                                          to-y (+ to-addr-y
+                                                  (* line-height
+                                                     (get coords [to-addr to-port])))
+                                          dx (- from-x to-x)
+                                          dy (- to-y from-y)
+                                          rad (Math/atan2 dx dy)
+                                          dist (Math/abs (Math/sqrt (+ (* dx dx)
+                                                                       (* dy dy))))
+                                          prev-msgs (get-in
+                                                     @prev-addrs
+                                                     [addr :outs
+                                                      [accept-addr accept-port]
+                                                      [from-port to-addr to-port]])]
+                                      ["
"
+                                       "
"
+                                       from-port " --> "
+                                       to-addr ":" to-port "
"
+                                       "
"
+                                       "  <div class='msgs"
+                                       (when (= accept-addr addr)
+                                         " to-client")
+                                       "' style='min-height:" (- dist 60) "px;"
+                                       "transform-origin:top left;"
+                                       "-ms-transform-origin:top left;"
+                                       "-webkit-transform-origin:top left;"
+                                       "transform:rotate(" rad "rad);"
+                                       "-ms-transform:rotate(" rad "rad);"
+                                       "-webkit-transform:rotate(" rad "rad);'>"
+                                       (render-msgs msgs prev-msgs dist line-height)
+                                       "
"
+                                       "
"
+                                       "
"]))
+                                  (sort-by first accept-addr-port-v))
                                  "
"])
                               (sort-by first (:outs addr-v)))
                         "
"]))
@@ -184,15 +207,16 @@
 (defn world-vis-init [el-prefix init-event-delay]
   (let [cmd-inject-ch (chan)
         cmd-ch (replay-cmd-ch cmd-inject-ch (keys cbfg.world.lane/cmd-handlers)
-                              (fn [ev] {:op (.-id (.-target ev))
-                                        :x (js/parseInt (get-el-value "x"))
-                                        :y (js/parseInt (get-el-value "y"))
-                                        :delay (js/parseInt (get-el-value "delay"))
-                                        :fence (= (get-el-value "fence") "1")
-                                        :lane (get-el-value "lane")
-                                        :client (get-el-value "client")
-                                        :color (get-el-value "color")
-                                        :sleep (js/parseInt (get-el-value "sleep"))}))
+                              (fn [ev]
+                                {:op (.-id (.-target ev))
+                                 :x (js/parseInt (get-el-value "x"))
+                                 :y (js/parseInt (get-el-value "y"))
+                                 :delay (js/parseInt (get-el-value "delay"))
+                                 :fence (= (get-el-value "fence") "1")
+                                 :lane (get-el-value "lane")
+                                 :client (get-el-value "client")
+                                 :color (get-el-value "color")
+                                 :sleep (js/parseInt (get-el-value "sleep"))}))
         render-state (atom {})
         num-clients 3]
     (vis-init (fn [world vis-chs]
@@ -204,26 +228,31 @@
                   (act init-world world
                        (aput init-world listen-ch [:server 8000 listen-result-ch0])
                        (aput init-world listen-ch [:server 8100 listen-result-ch1])
-                       (let [[accept-ch0 close-accept-ch0] (atake init-world listen-result-ch0)
-                             [accept-ch1 close-accept-ch1] (atake init-world listen-result-ch1)]
+                       (let [[accept-ch0 close-accept-ch0]
+                             (atake init-world listen-result-ch0)
+                             [accept-ch1 close-accept-ch1]
+                             (atake init-world listen-result-ch1)]
                          (server-accept-loop world accept-ch0 close-accept-ch0)
                          (server-accept-loop world accept-ch1 close-accept-ch1)
                          (let [req-ch (achan init-world)
                                res-ch (achan init-world)
                                server-ports (cycle [8000 8100])
-                               client-cmd-chs (reduce
-                                               (fn [acc i]
-                                                 (let [client-id (str "client-" i)]
-                                                   (assoc acc client-id
-                                                          (client-loop world connect-ch
-                                                                       :server (nth server-ports (count acc))
-                                                                       (keyword client-id) res-ch))))
-                                               {} (range num-clients))]
+                               client-cmd-chs
+                               (reduce
+                                (fn [acc i]
+                                  (let [client-id (str "client-" i)]
+                                    (assoc acc client-id
+                                           (client-loop world connect-ch
+                                                        :server (nth server-ports
+                                                                     (count acc))
+                                                        (keyword client-id) res-ch))))
+                                {} (range num-clients))]
                            (world-cmd-loop world cbfg.world.lane/cmd-handlers cmd-ch
                                            req-ch res-ch vis-chs world-vis-init el-prefix)
                            (act-loop cmd-dispatch-loop world [num-dispatches 0]
                                      (when-let [msg (atake cmd-dispatch-loop req-ch)]
-                                       (when-let [client-cmd-ch (get client-cmd-chs (:client msg))]
+                                       (when-let [client-cmd-ch
+                                                  (get client-cmd-chs (:client msg))]
                                          (aput cmd-dispatch-loop client-cmd-ch msg)
                                          (recur (inc num-dispatches))))))))))
               el-prefix


Unified resource-properties

Unified resource-properties

--- src/yada/resource.clj
+++ src/yada/resource.clj
@@ -53,8 +53,13 @@
    (s/optional-key :representations)
    RepresentationSets

+   (s/optional-key :last-modified) Date
+   (s/optional-key :version) s/Any
+
    (s/optional-key :collection?)
-   (s/maybe s/Bool)
+   s/Bool
+
+   (s/optional-key :exists?) s/Bool

    QualifiedKeyword s/Any})

@@ -85,21 +90,11 @@

 ;; ---

-(s/defschema ResourcePropertiesOnRequest
-  {:exists? s/Bool
-   (s/optional-key :last-modified) Date
-   (s/optional-key :version) s/Any
-   (s/optional-key :representations) RepresentationSets
-   QualifiedKeyword s/Any})
-
-(def coerce-resource-properties-on-request
-  (sc/coercer ResourcePropertiesOnRequest +resource-properties-coercions+))
-
 ;; The reason we can't have multiple arities is that s/defn has a
 ;; limitation that 'all arities must share the same output schema'.
-(s/defn resource-properties-on-request :- ResourcePropertiesOnRequest
+(s/defn resource-properties-on-request :- ResourceProperties
   [r ctx]
-  (coerce-resource-properties-on-request
+  (coerce-resource-properties
    (merge
     {:exists? true}
     (try


Batch scrolls and only scroll based on farthest

* Allows two/three/four finger scrolls where playhead tracks finger that has moved the farthest.

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -2,7 +2,7 @@
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [goog.dom :as dom]
             [goog.events :as events]
-            [cljs.core.async :as async :refer [<! >! chan timeout sliding-buffer mapcat<
+            [cljs.core.async :as async :refer [<! >! chan timeout sliding-buffer map<
                                                onto-chan]]
             [playmary.util :as util]
             [playmary.scales :as scales]))
@@ -259,7 +259,7 @@

 (defn touches
   [canvas-id type]
-  (mapcat< touch-data->touches (util/listen (dom/getElement canvas-id) type)))
+  (map< touch-data->touches (util/listen (dom/getElement canvas-id) type)))

 (defn scrolling-touch?
   [touches cur-t]
@@ -271,28 +271,32 @@
                   (> (.abs js/Math (- (-> prev-t :position :y) (-> cur-t :position :y)))
                      10))))))

-(defmulti handle-touch (fn [t touches out-c] (:type t)))
-
-(defmethod handle-touch "touchstart"
-  [{touch-id :touch-id :as t} touches out-c]
-  (go
-   (assoc touches touch-id t)))
-
-(defmethod handle-touch "touchmove"
-  [{touch-id :touch-id :as t} touches out-c]
-  (go
-   (if (scrolling-touch? touches t)
-     (let [{{x1 :x y1 :y} :position} (get touches touch-id)
-           {{x2 :x y2 :y} :position} t
-           scroll (-> t (assoc :x-distance (- x1 x2)) (assoc :y-distance (- y1 y2)))]
-       (>! out-c scroll)
-       (assoc touches touch-id scroll))
-     touches)))
-
-(defmethod handle-touch "touchend"
-  [{touch-id :touch-id :as t} touches out-c]
-  (go
-   (assoc touches touch-id t)))
+(defmulti handle-touches (fn [new-touches cur-touches out-c] (-> new-touches first :type)))
+
+(defmethod handle-touches "touchstart"
+  [new-touches cur-touches _]
+  (go
+   (merge cur-touches (zipmap (map :touch-id new-touches) new-touches))))
+
+(defmethod handle-touches "touchmove"
+  [new-touches cur-touches out-c]
+  (go
+   (if-let [scroll (->> new-touches
+                        (filter (partial scrolling-touch? cur-touches))
+                        (map (fn [{touch-id :touch-id :as t}]
+                               (assoc t :y-distance
+                                      (- (get-in cur-touches [touch-id :position :y])
+                                         (get-in t [:position :y])))))
+                        (sort-by :y-distance >)
+                        first)]
+     (do (>! out-c scroll)
+         (assoc cur-touches (scroll :touch-id) scroll))
+     cur-touches)))
+
+(defmethod handle-touches "touchend"
+  [new-touches cur-touches _]
+  (go
+   (merge cur-touches (zipmap (map :touch-id new-touches) new-touches))))

 (defn emit-touch?
   [{t-type :type t-ticks :ticks} touches]
@@ -318,7 +322,7 @@
           (let [[v _] (alts! [c-touchstart c-touchmove c-touchend (timeout wait)])]
             (if (nil? v)
               (recur (<! (touch-tick touches out-c)))
-              (recur (<! (handle-touch v touches out-c)))))))
+              (recur (<! (handle-touches v touches out-c)))))))
     out-c))

 (defn step-time


Allow specifying outputf params in vectors

Instead of just accepting functions (or function-like objects such as
keywords) as parameters for outputf, be smarter about parsing what comes
in. In particular, a vector is accepted, and will be interpreted as a
series of functions to apply to the state map, left to right. This
allows accessing deeply nested elements just by passing e.g. [:last
:params] instead of #(get-in % [:last :params]). Also, if the functions
are not actually functions, they will be interpreted as keys to look up
in the object resulting from previous transformations (as long as said
object is associative). This will allow passing e.g. [3 :last :params]
although I don't think this functionality is useful anywhere yet.

--- cortex/src/cortex/optimise/descent.clj
+++ cortex/src/cortex/optimise/descent.clj
@@ -226,7 +226,20 @@
   (fn [state]
     (apply util/sprintf fmt
            (for [arg args]
-             (arg state)))
+             (let [transforms (if (vector? arg)
+                                arg
+                                [arg])]
+               (loop [state state
+                      transforms transforms]
+                 (if (seq transforms)
+                   (let [transform (first transforms)]
+                     (recur (cond
+                              (fn? transform)
+                              (transform state)
+                              (associative? state)
+                              (get state transform))
+                            (rest transforms)))
+                   state)))))
     (flush)
     (terminate? state)))


Renamings

Renamings

--- src/clj/algorithms_clj/huffman.clj
+++ src/clj/algorithms_clj/huffman.clj
@@ -28,7 +28,7 @@
       (make-node (peek heap) (peek rest))
       )))

-(defn- make-tree-impl
+(defn- merge-lowest-recursively
   "Build the huffman tree from the priority map"
   [heap]
   (if (< 1 (count heap))
@@ -37,11 +37,11 @@

 (defn make-tree
   "Build the huffman tree from a list of (value, frequence) pairs"
-  [inputs]
-  (->
-    (priority-map)
-    (into (map make-leaf) inputs)
-    make-tree-impl
+  [value-frequency-pairs]
+  (->>
+    value-frequency-pairs
+    (into (priority-map) (map make-leaf))
+    merge-lowest-recursively
     first))

@@ -51,11 +51,11 @@

 (defn- get-bits
   [huffman-tree val]
-  (defn get-bits-impl [{:keys [values lhs rhs]} dirs]
+  (defn get-bits-impl [{:keys [values lhs rhs]} directions]
     (cond
-      (= 1 (count values)) dirs
-      (-> lhs :values val) (recur lhs (conj dirs 0))
-      (-> rhs :values val) (recur rhs (conj dirs 1))
+      (= 1 (count values)) directions
+      (-> lhs :values val) (recur lhs (conj directions 0))
+      (-> rhs :values val) (recur rhs (conj directions 1))
       ))
   (get-bits-impl huffman-tree []))


Snapshot version

Snapshot version

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.17.3"
+(defproject cook "1.17.4-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


most end points are reads. will wrap on write end points individually

--- src/clj/apollo/core.clj
+++ src/clj/apollo/core.clj
@@ -97,7 +97,7 @@
 (defn wrap-db-transaction [h]
   (fn [request]
     (with-db db
-      (transaction (h request)))))
+      (h request))))

 (def app
   (-> http-handler


Fix default display.

Fix default display.

--- src/clj/quil/applet.clj
+++ src/clj/quil/applet.clj
@@ -77,7 +77,8 @@
   (PApplet/runSketch
    (into-array String
                (vec (filter string?
-                            [(str "--display=" (:display (meta applet)))
+                            [(when (:display (meta applet))
+                               (str "--display=" (:display (meta applet))))
                              (when (and (:bgcolor (meta applet))
                                         (:present (meta applet)))
                                (str "--bgcolor" "=" (str (:bgcolor (meta applet)))))
@@ -106,6 +107,13 @@
 (defn- display-size
   "Returns size of screen. If there are 2 or more screens it probably return size of
   default one whatever it means."
+  ([]
+   (let [bounds (.. (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
+                    getDefaultScreenDevice
+                    getDefaultConfiguration
+                    getBounds)]
+     [(.-width bounds) (.-height bounds)]))
+
   ([display]
    (if-let [bounds (some->
                     (get (.getScreenDevices (GraphicsEnvironment/getLocalGraphicsEnvironment)) display)
@@ -119,7 +127,7 @@
   "Checks that the size vector is exactly two elements. If not, throws
   an exception, otherwise returns the size vector unmodified."
   [size display]
-  (cond (= size :fullscreen) (display-size display)
+  (cond (= size :fullscreen) (apply display-size display)
         (and (coll? size) (= 2 (count size))) size
         :else (throw (IllegalArgumentException.
                       (str "Invalid size definition: " size ". Was expecting :fullscreen or 2 elements vector: [x-size y-size].")))))
@@ -372,12 +380,13 @@
                       options
                       (safe-fns options))

-        display           (or (:display options) 0)
-
         options           (merge (dissoc options :features)
                                  features)

+        display           (let [d (:display options)]
+                            (if d [d] []))
         size              (process-size (:size options) display)
+
         title             (or (:title options) (str "Quil " (swap! untitled-applet-id* inc)))
         renderer          (or (:renderer options) :java2d)
         draw-fn           (or (:draw options) no-fn)
@@ -402,7 +411,7 @@
                                   :draw-fn draw-fn
                                   :renderer renderer
                                   :size size
-                                  :display display
+                                  :display (:display options)
                                   :target-frame-rate (atom 60)}
                                  listeners)
         prx-obj           (quil.Applet. applet-state)]


Added juxt with modifications relevant to existing cljs functions

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -521,6 +521,42 @@
             (recur ((first fs) ret) (next fs))
             ret))))))

+(defn juxt
+  "Takes a set of functions and returns a fn that is the juxtaposition
+  of those fns.  The returned fn takes a variable number of args, and
+  returns a vector containing the result of applying each fn to the
+  args (left-to-right).
+  ((juxt a b c) x) => [(a x) (b x) (c x)]"
+  ([f]
+     (fn
+       ([] (vector (f)))
+       ([x] (vector (f x)))
+       ([x y] (vector (f x y)))
+       ([x y z] (vector (f x y z)))
+       ([x y z & args] (vector (apply f x y z args)))))
+  ([f g]
+     (fn
+       ([] (vector (f) (g)))
+       ([x] (vector (f x) (g x)))
+       ([x y] (vector (f x y) (g x y)))
+       ([x y z] (vector (f x y z) (g x y z)))
+       ([x y z & args] (vector (apply f x y z args) (apply g x y z args)))))
+  ([f g h]
+     (fn
+       ([] (vector (f) (g) (h)))
+       ([x] (vector (f x) (g x) (h x)))
+       ([x y] (vector (f x y) (g x y) (h x y)))
+       ([x y z] (vector (f x y z) (g x y z) (h x y z)))
+       ([x y z & args] (vector (apply f x y z args) (apply g x y z args) (apply h x y z args)))))
+  ([f g h & fs]
+     (let [fs (list* f g h fs)]
+       (fn
+         ([] (reduce #(conj %1 (%2)) [] fs))
+         ([x] (reduce #(conj %1 (%2 x)) [] fs))
+         ([x y] (reduce #(conj %1 (%2 x y)) [] fs))
+         ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))
+         ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))
+

 (comment
   (use 'cljs.compiler)


Clarify comment about outer boxing

Clarify comment about outer boxing

--- src/re_demo/core.cljs
+++ src/re_demo/core.cljs
@@ -182,8 +182,8 @@
       []
       [h-box
        ;; Outer-most box height must be 100% to fill the entrie client height.
-       ;; (height is 100% of body, which must have already had it's height set to 100%)
-       ;; width doesn't need to be initially set
+       ;; This assumes that height of <body> is itself also set to 100%.
+       ;; width does not need to be set.
        :height   "100%"
        :gap      "60px"
        :children [[scroller
@@ -201,6 +201,4 @@

 (defn ^:export mount-demo
   []
-  (reagent/render [main] (get-element-by-id "app"))
-  ;(reagent/render [display-green-messages] (util/get-element-by-id "app")) ;; TODO: EXPERIMENT - REMOVE
-  )
+  (reagent/render [main] (get-element-by-id "app")))


spec the search term

spec the search term

* presently we manually test the spec in xhr-search but perhaps
  we should switch to using s/fdef there

--- cljs/sledge/core.cljs
+++ cljs/sledge/core.cljs
@@ -2,6 +2,7 @@
   (:require-macros [cljs.core.async.macros :refer [go alt!]])
   (:import [goog.net XhrIo] goog.Uri)
   (:require [goog.events :as events]
+            [cljs.spec :as s]
             [cljsjs.react :as React]
             [cljs.test :refer-macros [deftest is testing]]
             [clojure.string :as string]
@@ -29,7 +30,6 @@
               :audio-el {:track-offset 0 :playing false :ready-state nil}
               }
      }))
-

 (defn empty-queue [] {:tracks [] :current-track 0})

@@ -183,8 +183,20 @@
         ))))

+(s/def ::search-term
+  (s/or
+   ::comparison (s/tuple #{:= :like} string? string?)
+   ::shuffle (s/tuple #{:shuffle} string? )))
+
+(deftest specs
+  ;; these tests are here as experiments to see if I'm using
+  ;; clojure.spec correctly, not as tests of clojure.spec
+  (is (s/valid? ::search-term [:= "artist" "Lou Reed"]))
+  (is (s/valid? ::search-term [:shuffle "Manic Thursday"])))
+
 (defn xhr-search [term]
-  (let [json-term (apply vector "and" term)
+  (let [conformed-term (s/conform (s/coll-of ::search-term) term)
+        json-term (apply vector "and" conformed-term)
         body (.stringify js/JSON (clj->js json-term))
         channel (chan)]
     (.send XhrIo "/tracks.json"
@@ -448,6 +460,7 @@
                             }})
                (:tracks queue) (range 0 999))
           ])))))
+

 (defmulti format-search-term (fn [op & terms] op))


add a better test for inputstream parsing

--- test/cheshire/test/core.clj
+++ test/cheshire/test/core.clj
@@ -1,10 +1,10 @@
 (ns cheshire.test.core
   (:use [clojure.test]
-        [clojure.java.io :only [reader]])
+        [clojure.java.io :only [file reader]])
   (:require [cheshire.core :as json]
             [cheshire.factory :as fact]
             [cheshire.parse :as parse])
-  (:import (java.io StringReader StringWriter
+  (:import (java.io FileInputStream StringReader StringWriter
                     BufferedReader BufferedWriter)
            (java.sql Timestamp)
            (java.util Date UUID)))
@@ -125,7 +125,11 @@
   (is (= {"one" 1, "foo" "bar"}
          (first (json/parsed-seq (reader "test/multi.json")))))
   (is (= {"two" 2, "foo" "bar"}
-         (second (json/parsed-seq (reader "test/multi.json"))))))
+         (second (json/parsed-seq (reader "test/multi.json")))))
+  (with-open [s (FileInputStream. (file "test/multi.json"))]
+    (let [r (reader s)]
+      (is (= [{"one" 1, "foo" "bar"} {"two" 2, "foo" "bar"}]
+             (json/parsed-seq r))))))

 (deftest test-jsondotorg-pass1
   (let [string (slurp "test/pass1.json")


Wrong default, to be consistent with in-container

--- web/src/immutant/web/middleware.clj
+++ web/src/immutant/web/middleware.clj
@@ -45,7 +45,7 @@
   Supported options:

      * :timeout The number of seconds of inactivity before session expires [1800]
-     * :cookie-name The name of the cookie that holds the session key [\"ring-session\"]
+     * :cookie-name The name of the cookie that holds the session key [\"JSESSIONID\"]
      * :cookie-attrs A map of attributes to associate with the session cookie [nil]

   A :timeout value less than or equal to zero indicates the session


I'm not positive...but this version looks like it might actually be not failing horrifically.

--- src/frereth_server/auth_socket.clj
+++ src/frereth_server/auth_socket.clj
@@ -7,11 +7,10 @@
   (:gen-class))

 (defn- log [msg]
-  "FIXME: Debug only.
-Q: Really?
-A: Well, if nothing else, this is mostly useless. Desperately need something
-that resembles real logging."
-  (spit "/tmp/log.txt" (str msg)))
+  "FIXME: Debug only."
+  (with-open [w (io/writer "/tmp/log.txt" :append true)]
+    (.write w (str msg))
+    (.write w "\n")))

 (defn- read-message [s]
   (mq/recv-all-str s))
@@ -46,6 +45,7 @@
 (defmethod dispatch "dieDieDIE!!"
   [_]
   ;; Really just a placeholder message indicting that it's OK to quit
+  ;; Note that we are *not* getting here
   (log "Quit permission")
   "K")

@@ -57,8 +57,9 @@
 (defmethod dispatch :list [msgs]
   ;; Based on the next line, I have something like a Vector of byte arrays.
   ;; Which seems pretty reasonable.
+  (log "Dispatching :list:\n")
   (log msgs)
-  (log "\n(that's some sort of SEQ of messages)")
+  (log "\n(that's some sort of SEQ of messages)\n")

   ;; Q: What are the odds that I can call a method this way?
   (comment (dorun dispatch msgs))
@@ -73,13 +74,19 @@
   ;; Or possibly my real problem is laziness?
   (comment (for [m msgs]
              (throw (RuntimeException. (str m)))))
+
+  (comment (log "Anything interesting?\n"))
+
+  (log msgs)
   (if-let [car (first msgs)]
     (do
       (log car)
       (dispatch (rest msgs)))
     (do
       (log (str "Empty CAR. CDR: " (rest msgs)))))
-  (throw (RuntimeException. (str (first msgs)))))
+
+  (comment (log "Seriously?"))
+  (comment (throw (RuntimeException. (str (first msgs))))))

 (defmethod dispatch :default
   [echo]
@@ -180,7 +187,7 @@
 done-reference is some sort of deref-able instance that will tell the thread to quit.
 This feels like an odd approach, but nothing more obvious springs to mind."
   [ctx done-reference]
-  (println "Kicking off the authentication runner thread in context: "
-           ctx "\nwaiting on Done Reference " done-reference)
+  (log (str "Kicking off the authentication runner thread in context: "
+            ctx "\nwaiting on Done Reference " done-reference))
   (.start (Thread. (fn []
                      (authenticator ctx done-reference)))))


add test

add test

--- test/babel/test/es.clj
+++ test/babel/test/es.clj
@@ -25,6 +25,12 @@
   (let [result (es/expression {:synsem {:sem {:pred :be-called}}})]
     (not (empty? (fo result)))))

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

+


Simplified for our purposes.

Simplified for our purposes.

--- src/sormilla/leap.clj
+++ src/sormilla/leap.clj
@@ -3,48 +3,42 @@

 (set! *warn-on-reflection* true)

-(def gesture-type {:swipe       Gesture$Type/TYPE_SWIPE
-                   :circle      Gesture$Type/TYPE_CIRCLE
-                   :screen-tap  Gesture$Type/TYPE_SCREEN_TAP
-                   :key-tap     Gesture$Type/TYPE_KEY_TAP})
+(defn connect []
+  (Controller.))

-(defn connect []
-  (Controller.)
-  #_(doseq [g (vals gesture-type)]
-    (.enableGesture c g)))
-
-(defn ->vector [^Vector v]
-  [(.getX v) (.getY v) (.getZ v)])
-
-(defn ->finger [^Pointable f]
-  (-> f .tipPosition ->vector))
-
-(defn valid? [^Pointable f]
-  (.isValid f))
-
-(defn ->sphere [^Hand h]
-  (when h
-    (conj (->vector (.sphereCenter h)) (double (.sphereRadius h)))))
+(defn ->hand [^Hand hand]
+  (when (and hand (.isValid hand))
+    (let [direction  (.direction hand)
+          normal     (.palmNormal hand)]
+      {:finger-count  (->> hand .fingers .count)
+       :pitch         (.pitch direction)
+       :yaw           (.yaw direction)
+       :roll          (.roll normal)})))

 (defn frame [^Controller c]
-  (let [f (.frame c)
-        hands (.hands f)
-        both? (> (.count hands) 1)
-        lh (.leftmost hands)
-        rh (.rightmost hands)
-        lh (when (and lh (.isValid lh)) lh)
-        rh (when (and both? rh (.isValid rh)) rh)
-        lf (when lh (->> lh .fingers seq (filter valid?) (map ->finger)))
-        rf (when rh (->> rh .fingers seq (filter valid?) (map ->finger)))]
-    [lf (->sphere lh) rf (->sphere rh)]))
+  (let [f             (.frame c)
+        hands         (.hands f)
+        hand-count    (.count hands)
+        left-hand     (when (pos? hand-count) (->hand (.rightmost hands)))
+        right-hand    (when (> hand-count 1) (->hand (.leftmost hands)))]
+    {:left left-hand
+     :right right-hand}))

 (comment

   (def c (connect))
   (frame c)

+  (require '[clojure.pprint :refer [pprint]])
+
+  (dotimes [n 10]
+    (Thread/sleep 100)
+    (pprint (frame c)))
+
   (dotimes [n 100]
     (Thread/sleep 100)
-    (dorun (map (fn [[x y z]] (printf "%10.3f  %10.3f  %10.3f\n" x y z) (flush)) (first (frame c)))))
+    (let [[pitch yaw roll] ((juxt :pitch :yaw :roll) (:left (frame c)))]
+      (printf "%15.3f %15.3f %15.3f\n" pitch yaw roll)
+      (flush)))

 )


Fix bugs

Fix bugs

--- src/specium/core.cljc
+++ src/specium/core.cljc
@@ -22,13 +22,13 @@
              (catch :default _ nil))))

 (defn ->spec [x]
-  (cond (or (keyword? x) (set? x)) x
+  (cond (or (keyword? x) (set? x) (fn? x)) x
         (symbol? x) (resolve* x)
         :else (->spec* x)))

-(defmethod ->spec* `s/spec [[_ form]]
+(defmethod ->spec* `s/spec [[_ form & {:keys [gen]}]]
   (when form
-    (s/spec-impl form (->spec form) nil nil)))
+    (s/spec-impl form (->spec form) (some-> gen ->spec) nil)))

 (defmethod ->spec* `s/multi-spec [[_ mm retag]]
   ;; Essentially identical to `delay`, but won't cache the result.
@@ -163,7 +163,7 @@
 (defmethod ->spec* `s/fspec [[_ & {:keys [args ret fn gen] :or {ret `any?}}]]
   (s/fspec-impl (->spec `(s/spec ~args)) args
                 (->spec `(s/spec ~ret)) ret
-                (->spec `(s/spec fn)) fn
+                (->spec `(s/spec ~fn)) fn
                 (some-> gen ->spec)))

 (defmethod ->spec* `s/conformer [[_ f unf]]


Remove quotations from comic names on Manga Here

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -100,7 +100,9 @@
          manga-url     (format "%s/manga" canonical-url)
          mangalist-url (format "%s/mangalist/" canonical-url)
          manga-pattern (re-pattern (str manga-url "/(.*?)/"))
-         link->map (gen-link->map second identity)]
+         link->map (gen-link->map (comp #(s/replace % #"\"" "")
+                                        second)
+                                  identity)]
      {:id :manga-here
       :name "Manga Here"
       :comic->url (fn [comic-id]


modified div

modified div

--- src/complex/number.cljc
+++ src/complex/number.cljc
@@ -133,14 +133,16 @@

 (defn div
   "divide two complex numbers"
-  [z w]
-  (cond
-    (and (= z infinity) (= w infinity)) undefined
-    (and (= z zero) (= w zero)) undefined
-    (= w infinity) zero
-    (= z zero) zero
-    (= w zero) infinity
-    :else (times z (recip w))))
+  ([] one)
+  ([z] (div one z))
+  ([z w]
+   (cond
+     (and (= z infinity) (= w infinity)) undefined
+     (and (= z zero) (= w zero)) undefined
+     (= w infinity) zero
+     (= z zero) zero
+     (= w zero) infinity
+     :else (times z (recip w)))))

 (defn len-sq [z]
   (let [w (mult z (conjugate z))


Functions get-api-prefix and verbose? in the config module


simplified code

simplified code

--- test/forma/postprocess/select_test.clj
+++ test/forma/postprocess/select_test.clj
@@ -119,10 +119,8 @@

 (defn vectorize-output
   []
-  (let [ts-tap (<- [?cntry ?ts]
-                   (pxtap ?cntry ?pd ?tot-prob)
-                   (docat ?tot-prob :> ?ts))]
-    (?<- (stdout)
-         [?cntry]
-         (ts-tap ?cntry ?ts)
-         (graph-ts ?cntry ?ts))))
+  (?<- (stdout)
+       [?cntry]
+       (pxtap ?cntry ?pd ?tot-prob)
+       (docat ?tot-prob :> ?ts)
+       (graph-ts ?cntry ?ts)))


fix dragging

fix dragging

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

--- plugins/SlideExplorer2/src/slide_explorer/canvas1.clj
+++ plugins/SlideExplorer2/src/slide_explorer/canvas1.clj
@@ -480,8 +480,6 @@
           :top 20
           :text (.getMessage e)}]))

-(def count-paints (atom 0))
-
 (defn canvas
   "Create a blank JPanel \"canvas\" for automatic painting. The
   canvas is automatically updated with the graphics description
@@ -491,24 +489,18 @@
         panel (proxy [JPanel clojure.lang.IReference] []
                 (paintComponent [^Graphics graphics]
                   (proxy-super paintComponent graphics)
-                   ; (println "draw" (now))
                   (paint/paint-buffered graphics
-                  #(try
-                     (draw % @reference)
-                    (catch Throwable e (draw-error % e)))))
+                    #(try
+                       (draw % @reference)
+                       (catch Throwable e (draw-error % e)))))
                 (alterMeta [alter args]
                   (apply swap! meta-atom alter args))
                 (resetMeta [m]
                   (reset! meta-atom m))
                 (meta []
                   @meta-atom))]
-    ;(.setDoubleBuffered panel true)
     (add-watch reference panel (fn [_ _ old-val new-val]
-                                 (swap! count-paints inc)
-                                 ;(println "count: " @count-paints)
-                                 ;(clojure.pprint/pprint new-val)
                                  (when (not= old-val new-val)
-                                   ;(println "repaint")
                                    (.repaint panel))))
     (alter-meta! panel assoc ::data-source reference)
     panel))
@@ -521,28 +513,34 @@
     (fn [x y] ((widget action-type)
                  (- x offset-x) (- y offset-y)))))

-(defn match-shapes [[x y] data]
+(defn shapes-containing-point
+  "Returns the shapes in data that contain the
+   point [x y]."
+  [[x y] data]
   (->> data
        (filter #(-> (.createTransformedShape
-                           (% :transform) (% :shape)) (.contains x y)))))
-
-(defn triggered-mouse-actions [action-type [x y] data]
+                       (% :transform) (% :shape))
+                    (.contains x y)))))
+
+(defn shape-by-action [action-type [x y] data]
   (->> data
        expand-memo
        (filter action-type)
-       (match-shapes [x y])
-       (map #(create-action % action-type))))
+       (shapes-containing-point [x y])))

 (defn run-mouse-actions [e action-type reference]
   (let [x (.getX e) y (.getY e)]
-    (doseq [action (triggered-mouse-actions action-type [x y] @reference)]
-      (action x y))))
-
-(defn mouse-is-over [[x y] data]
+    (doseq [shape (shape-by-action action-type [x y] @reference)]
+      ((:action-type shape) x y))))
+
+(defn mouse-is-over
+  "Returns the shapes that contain the point [x y] and
+   expect a hovering mouse."
+  [[x y] data]
   (->> data
        expand-memo
        (remove #(empty? (select-keys % [:mouse-in :mouse-out])))
-       (match-shapes [x y])))
+       (shapes-containing-point [x y])))

 (defn handle-mouse-move [e reference canvas]
   ;(println "move" (now))
@@ -557,26 +555,32 @@
     (doseq [action (map :mouse-in in)] (when action (action)))
     (doseq [action (map :mouse-out out)] (when action (action)))))

-(defn activate-dragging! [e reference canvas]
-  (let [x (.getX e) y (.getY e)]
+(defn initiate-dragging!
+  "Initiates a dragging session."
+  [e reference canvas]
+  (let [x0 (.getX e) y0 (.getY e)
+        dragee (last (shape-by-action :on-mouse-drag [x0 y0] @reference))
+        {:keys [x y]} dragee
+        dx (- x x0) dy (- y y0)]
     (alter-meta! canvas assoc
                  ::dragging-action
-                   (last (triggered-mouse-actions
-                           :on-mouse-drag [x y] @reference))
-                 ::last-drag-position [x y])))
-
-(defn stop-dragging! [canvas]
-  (alter-meta! canvas dissoc ::dragging-action))
-
-(defn continue-dragging [e canvas]
+                 (:on-mouse-drag dragee)
+                 ::dragging-offset [dx dy])))
+
+(defn continue-dragging!
+  "Updates a dragging session."
+  [e canvas]
   (let [x (.getX e) y (.getY e)
         canvas-meta (meta canvas)
-        [x0 y0] (::last-drag-position canvas-meta)
-        dx (- x x0) dy (- y y0)]
-    (alter-meta! canvas assoc
-                 ::last-drag-position [x y])
+        [dx dy] (::dragging-offset canvas-meta)
+        xnew (+ x dx) ynew (+ y dy)]
     (when-let [action (canvas-meta ::dragging-action)]
-      (action dx dy))))
+      (action xnew ynew))))
+
+(defn finish-dragging!
+  "Halts a dragging session."
+  [canvas]
+  (alter-meta! canvas dissoc ::dragging-action))

 (defn interactive-canvas
   [reference]
@@ -585,13 +589,13 @@
         mouse-adapter
         (proxy [MouseAdapter] []
           (mouseClicked [e] (run-mouse-actions e :mouse-click reference))
-          (mousePressed [e] (activate-dragging! e reference canvas)
+          (mousePressed [e] (initiate-dragging! e reference canvas)
                             (run-mouse-actions e :mouse-down reference))
-          (mouseReleased [e] (stop-dragging! canvas)
+          (mouseReleased [e] (finish-dragging! canvas)
                              (run-mouse-actions e :mouse-up reference))
           (mouseMoved [e] (handle-mouse-move e reference canvas))
           (mouseDragged [e]
-                        (continue-dragging e canvas)
+                        (continue-dragging! e canvas)
                         (handle-mouse-move e reference canvas)))]
     (doto canvas
       (.addMouseListener mouse-adapter)
@@ -675,11 +679,11 @@
        :alpha 0.6
     :mouse-in #(swap! grafix assoc-in [2 :fill] :red)
     :mouse-out #(swap! grafix assoc-in [2 :fill] :pink)
-    :on-mouse-drag (fn [dx dy]
+    :on-mouse-drag (fn [x y]
                      (swap! grafix
                             #(-> %
-                                 (update-in [2 :x] + dx)
-                                 (update-in [2 :y] + dy))))
+                                 (assoc-in [2 :x] x)
+                                 (assoc-in [2 :y] y))))
     :scale 3
       :mouse-up (fn [x y] )
      :x 200


Add wip sass to css compiler task

Add wip sass to css compiler task

--- functions/project.clj
+++ functions/project.clj
@@ -9,12 +9,17 @@
                  [uswitch/lambada "0.1.2"]
                  [pjstadig/humane-test-output "0.8.2"]
                  [compojure "1.6.0"]
+                 [deraen/sass4clj "0.3.1"]
                  [ring/ring-defaults "0.2.1"]]
+  :sass4clj {:source-paths ["resources/public/css/scss"]
+             :target-path "resources/public/css"
+             :output-style :compressed}
   :ring {:handler wort.handler/app}
   :injections [(require 'pjstadig.humane-test-output)
                (pjstadig.humane-test-output/activate!)]
   :plugins [[lein-cljfmt "0.5.6"]
-	    [lein-ring "0.12.1"]]
+	        [lein-ring "0.12.1"]
+            [deraen/lein-sass4clj "0.3.1"]]
   :main ^:skip-aot wort.core
   :target-path "target/%s"
   :profiles {:uberjar {:aot :all}})


What's a Generagor?

What's a Generagor?

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -128,12 +128,12 @@
       (emit-string jg ESC "i" i as-map-key cache)
       (.writeNumber jg ^long i)))

-  (emit-double [^JsonGeneragor jg d as-map-key cache]
+  (emit-double [^JsonGenerator jg d as-map-key cache]
     (if as-map-key
       (emit-string jg ESC "d" d as-map-key cache)
       (.writeNumber jg ^double d)))

-  (emit-binary [^JsonGeneragor jg b as-map-key cache]
+  (emit-binary [^JsonGenerator jg b as-map-key cache]
     (emit-string jg ESC "b" (Base64/encodeBase64String b) as-map-key cache))

   (array-size [^JsonGenerator jg _] nil)


Create/delete on elements in list synchronizes across browsers

--- src/databinder/core.clj
+++ src/databinder/core.clj
@@ -45,65 +45,78 @@
 (defn plit [val]
   (. ResourceFactory createPlainLiteral val))

-(defn uuid [] (res (str "urn:uuid:" (java.util.UUID/randomUUID))))
-
-(def db (uris "http://logangilmour.com/data-binder#" :root :binds :bindo :haschild :projects :list :paragraph :text-field))
+(defn uuid [] (str "urn:uuid:" (java.util.UUID/randomUUID)))
+
+(def db (uris "http://logangilmour.com/data-binder#" :rank :root :binds :bindo :deleter :haschild :projects :list :paragraph :text-field))

 (def functions
   {(db :list)
-   {:bind (fn [uri binding predicate meta vals]
-            (hic/html [:p (:title meta)]
-                      [:ol {:data-uri uri
-                            :data-predicate predicate
+   {:resource (fn [uri binding meta vals]
+                (hic/html [:p (:title meta)]
+                          [:ol.list-binding {:data-uri uri
+                                :data-binding binding
+                                :data-description (:description meta)}
+                           vals]
+                          [:a.list-add-binding
+                           {:href "#"
+                            :data-uri uri
+                            :data-binding binding} "Create"]))
+    :value (fn [parent uri binding meta val]
+             (hic/html [:li {:data-uri uri} val]))
+
+    :update (fn [uri pred data]
+              {:type "create" :uri uri :predicate pred :value (uuid)})}
+
+   (db :deleter)
+   {:resource (fn [uri binding meta vals]
+                (hic/html [:a.remove-binding
+                                 {:href "#"
+                                  :data-uri uri
+                                  :data-binding binding
+                                  :data-value (apply str vals)} (:title meta)]))
+    :value (fn [parent uri binding meta val]
+             val)
+
+    :update (fn [uri pred data]
+              {:type "delete" :uri uri :predicate pred :value data})}
+
+   (db :paragraph)
+   {:resource (fn [uri binding meta vals]
+                (hic/html [:p {:data-uri uri
+                       :data-binding binding
+                       :data-description (:description meta)}
+                   (:title meta) ": " vals]))
+    :value (fn [parent uri binding meta val]
+             (hic/html val))
+    :update nil}
+
+   (db :text-field)
+   {:resource (fn [uri binding meta vals]
+                (hic/html [:label (str (:title meta) " ")
+                   [:input {:type "text"
+                            :class "text-field-binding"
+                            :data-uri uri
                             :data-binding binding
-                            :data-description (:description meta)}
-                       (map (fn [val] [:li (:html val) [:a.list-remove-binding
-                                               {:href "#"
-                                                :data-uri uri
-                                                :data-binding binding
-                                                :data-predicate predicate
-                                                :data-value (:uri val)} "X"]]) vals)
-                       [:a.list-add-binding
-                        {:href "#"
-                         :data-uri uri
-                         :data-binding binding
-                         :data-predicate predicate} "Create"]]))
-
-    :update (fn [uri pred data]
-              (cond (= (:type data) "add")
-                    {:type "create" :uri uri :predicate pred :value (uuid)}
-                    (= data "remove")
-                    {:type "remove" :uri uri :predicate pred :value (:value data)}))}
-
-   (db :paragraph)
-   {:bind (fn [uri binding predicate meta vals]
-            (hic/html [:p {:data-uri uri
-                           :data-binding binding
-                           :data-predicate predicate
-                           :data-description (:description meta)}
-                       (:title meta) ": " (map :html vals)]))
-    :update nil}
-
-   (db :text-field)
-   {:bind (fn [uri binding predicate meta vals]
-            (hic/html [:label (str (:title meta) " ")
-                       [:input {:type "text"
-                                :class "text-field-binding"
-                                :data-uri uri
-                                :data-predicate predicate
-                                :data-binding binding
-                                :data-description (:description meta)
-                                :value (apply str (map :html vals))}]]))
+                            :data-description (:description meta)
+                            :value (apply str vals)}]]))
+    :value (fn [parent uri binding meta val]
+             (hic/html val))
     :update (fn [uri pred data]
               {:type "update" :uri uri :predicate pred :value data})}})

 (defn relator [statement model resource]
+
   (let [binder (.getURI (.getPredicate statement))]
     (if (= binder (db :binds))
       (iterator-seq (.listResourcesWithProperty model (prop (.getURI (.asResource (.getObject statement)))) resource ))
-      (iterator-seq (.listObjectsOfProperty model resource (prop (.getURI (.asResource (.getObject statement)))))))
+      (iterator-seq
+       (.listObjectsOfProperty model resource
+                               (prop
+                                (.getURI
+                                 (.asResource
+                                  (.getObject statement)))))))
     ))

 ;;TODO projectors url should bind itself some stuff so it knows its unique values and its name
@@ -114,8 +127,10 @@
         (.getObject
          (.getProperty model binding (prop "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"))))))

-(defn literalize [literal]
-  (.getString (.asLiteral literal)))
+(defn literalize [res]
+  (if (.isLiteral res)
+    (.getString (.asLiteral res))
+    (.toString res)))

 (def dc (uris "http://purl.org/dc/elements/1.1/" :title :description))

@@ -131,30 +146,111 @@
        (.getProperty model binding (prop (:bindo db)))))

+;; take a thing and get its function
+;; are there sub-things? if so, get them and recurse
+;; if not, return the result of running the function on the thing and the empty list
+;;
+;; build a thing as we return up the tree.
+;; order things after we build them.
+
+;; necessary: bind:subject, bind:object, bind:order1 ... orderN, bind:haschild.
+
+;; bind:subject takes a function1 and a predicate and makes a function that takes an object and returns the result of calling the function1 on the right side of the predicate, filtered by object.
+;; bind:object ...
+;; bind:order takes a function and a
+
+;; take an object and a predicate and get the binding for that predicate and apply it to the object.
+
+;; a relation-function takes a resource and turns it into a function that takes a resource and turns it into a function... until strings.
+;; haschild: take a bunch of things and call tree-builder on them.
+
+
+
+
+;; The output point is when a function makes a function that returns strings.
+
+;; bind subject, object, and child are all bindings.
+
+;; haschild bind:object haschild
+
+;; Tree-builder algorithm:
+;; Takes an initial resource.
+;; Gets children by getting all properties of a type, then getting the bound functions for them, then , then
+;; recurses on children.
+;; returns aggregation of children run through the function for this resource.
+;; functions needed: make a sequence of children into a single thing, get the necessary children.
+;; haschild makes a function that returns the related values, while contains makes a function returns with the same values.
+
+;; tree builder takes a resource and a property.
+;; tree builder then gets all sub-resources pointed at by the property.
+;; tree builder orders those sub-resources.
+;; tree builder then runs the tree-ify function bound to the predicate on the resource and the children and returns the result.
+;; A binding function takes an object and a list of trees and makes a new tree with the object at the top.
+;; Each predicate that we follow in a tree has a binding function.
+;; A more complex tree of bindings
+
+
+;; tree-build starting from university of alberta, employee
+;; get a bunch of employees, including me
+;; tree-build on each of us for each predicate that matters. Is this by type? This is where recursive assembly comes in - building the right tree of tree-builders.
+;; sort the returned values by the bundled keys.
+;; apply the function for binding the employee relationship to the result of this map and the university.
+;; return
+
+;; parts definitely common to both: Ordering, getting all relations and then mapping a list of functions to them,
+
+;; Container: doesn't relate, just passes its values on to the next function.
+;; Projector: relates and recurses, but with a function that is somewhere else in the tree (no rendered children)
+;; Child: recurses and relates
+
+
+
+
+
+
+(defn relate-right [model predicate resource]
+  (iterator-seq (.listObjectsOfProperty model resource predicate)))
+
+(defn relate-left [model predicate resource]
+  (iterator-seq (.listResourcesWithProperty model predicate resource)))
+
+
 (defn s-rec [binding model]

-  (let [children (map (fn [val] (.asResource val))
-                      (iterator-seq (.listObjectsOfProperty
-                                     model
-                                     (.asResource binding)
-                                     (prop (:haschild db)))))
-
-        statement (get-bound binding model)
-
-        func (:bind (bound-func binding model))
-
-        relation-getter (fn [data resource] (relator statement data resource))
-
-        sub-calls (map (fn [child] (s-rec child model)) children)
+  (let [children (sort-by (fn [resource]
+                            (let [p (.getProperty model resource (prop (:rank db)))]
+                              (if p
+                                (.getString (.asLiteral (.getObject p)))
+                                "")))
+                          (relate-right model (prop (:haschild db)) binding))
+
+        statement (get-bound binding model) ;; fuckery for binding
+
+        parent-func (:resource (bound-func binding model)) ;; extraneous function getting
+        child-func (:value (bound-func binding model))
+
+        relation-getter (fn [data resource] (relator statement data resource)) ;; get the function that gets the children for this node, will be used to bulid the next value of tree-builder.
+
+        sub-calls (map (fn [child] (s-rec child model)) children) ;; make the next part of the tree
         meta-data (get-meta-data binding model)]

-    (fn [data resource]
-
-      (let [related (relation-getter data resource)]
-
-        (func (.getURI resource)
+    (fn [data child resource]
+
+      (let [related (if child   ;; get sub-resources (a single one if partial rendering)
+                      (seq [child])
+                      (relation-getter data resource))
+            func (if child ;; get the bound function
+                   (fn [uri bind meta vals]
+                     (let [val (first vals)]
+                       (child-func
+                        uri (:uri val) bind meta (:html val))))
+                   (fn [uri bind meta vals]
+                     (parent-func
+                      uri bind meta
+                      (map (fn [val] (child-func
+                                     uri (:uri val) bind meta (:html val))) vals))))]
+        (func (.getURI resource) ;; apply the bound function to the thing, the binding that points at the funtion, meta-data, and the finished children (should be ordered by now).
               (.getURI binding)
-              (.getURI (.getObject statement))
               meta-data
               (map (fn [val] {:uri (first val) :html (second val)})
                    (map vector
@@ -163,7 +259,7 @@
                           (map literalize related)
                           (map seq (apply map vector (map (fn [sub-call]
                                                             (map
-                                                             (partial sub-call data)
+                                                             (partial sub-call data nil)
                                                              related))
                                                           sub-calls)))))))))))

@@ -179,12 +275,12 @@
     ))

-
 (defn query-builder [command reversed]
-
   (cond (= (:type command) "update")
         (if reversed
           (simple-update "
+INSERT DATA {?s ?p ?o }
+
 DELETE { ?old ?p ?o }
 INSERT { ?s ?p ?o }
 WHERE { ?old ?p ?o }"
@@ -192,6 +288,8 @@
                          (prop (:predicate command))
                          (res (:uri command)))
           (simple-update "
+INSERT DATA {?s ?p ?o }
+
 DELETE { ?s ?p ?old }
 INSERT { ?s ?p ?o }
 WHERE { ?s ?p ?old }"
@@ -201,13 +299,25 @@
         (= (:type command) "create")
         (if reversed
           (simple-update "INSERT DATA { ?s ?p ?o }"
-                         ()
+                         (res (:value command))
                          (prop (:predicate command))
                          (res (:uri command)))
           (simple-update "INSERT DATA { ?s ?p ?o }"
                          (res (:uri command))
                          (prop (:predicate command))
-                         (plit (:value command))))
+                         (res (:value command))))
+
+        (= (:type command) "delete")
+        (if reversed
+          (simple-update "DELETE DATA { ?s ?p ?o }"
+                         (res (:value command))
+                         (prop (:predicate command))
+                         (res (:uri command)))
+          (simple-update "DELETE DATA { ?s ?p ?o }"
+                         (res (:uri command))
+                         (prop (:predicate command))
+                         (res (:value command))))
+
        ))

 (comment (if reversed
@@ -215,9 +325,26 @@
                    ))

 (defn get-all-bindings [inf predicate]
-  (concat (iterator-seq (.listResourcesWithProperty (prop (:binds db)) predicate))
-          (iterator-seq (.listResourcesWithProperty (prop (:bindo db)) predicate))))
-
+  (concat (iterator-seq (.listStatements inf nil (prop (:binds db)) predicate))
+          (iterator-seq (.listStatements inf nil (prop (:bindo db)) predicate))))
+
+
+(defn serializer
+  ([view-data]
+
+      (let [inf (. ModelFactory createRDFSModel view-data)
+            root (.asResource (.getObject (.getProperty inf
+                                                        (res (:root db))
+                                                        (prop (:haschild db)))))]
+
+        (fn [data resource] ((s-rec root inf) data nil resource))
+        ))
+  ([view-data binding]
+
+      (let [inf (. ModelFactory createRDFSModel view-data)]
+
+        (s-rec binding inf)
+        )))

 (defn editor [inf]
   (fn [model uri binding data]
@@ -225,36 +352,50 @@
           func (:update (bound-func binding inf))
           binder (.getURI (.getPredicate statement))
           predicate (.asResource (.getObject statement))
-          bindings (get-all-bindings inf predicate)
+          binders (get-all-bindings inf predicate)
+          bindings (map #(.getSubject %) binders)
+          views (map (partial serializer inf) bindings)
           pred (.getURI predicate)
-          resource (res uri)
+          resource (res uri) ;;TODO HERE make a serializer for each binding, then use them to populate action with html if this is an htmlable type thing. Consider moving to a pure update based strategy, as then we don't need javascript that's so complicated on the client side. We just regenerate any part of the view that's changed at any time. However, this means things like chat-rooms are not really viable.
           reverse (= binder (db :binds))
           graph-store (. GraphStoreFactory create model)
           command (func uri pred data)
           update (query-builder command reverse)
+
           ]

-      (println "!!!!!!!! " update)
+
+      (println "!!!!!! " update " !!!!!!!!")
       (. UpdateAction execute update graph-store)
-      command)))
-
-(defn serializer
-  ([view-data]
-
-      (let [inf (. ModelFactory createRDFSModel view-data)
-            root (.asResource (.getObject (.getProperty inf
-                                                        (res (:root db))
-                                                        (prop (:haschild db)))))]
-
-        (s-rec root inf)
-        ))
-  ([view-data binding]
-
-      (let [inf (. ModelFactory createRDFSModel view-data)]
-
-        (s-rec binding inf)
-        )))
-
+
+      (map (fn [binder]
+             (let [binding (.getSubject binder)
+                   reverse (= (.getURI (.getPredicate binder)) (db :binds))]
+
+              (dissoc
+               (cond
+                (or (= (:type command) "update") (= (:type command) "create"))
+                (assoc command
+                  :value
+                  ((serializer inf binding)
+                   model
+                   (if (= (:type command) "update")
+                     (plit (:value command))
+                     (res (:value command)))
+                   (res (:uri command)))
+                  :binding
+                  (.toString binding))
+
+                (= (:type command) "delete")
+                (assoc
+                    (if reverse
+                      (assoc command :uri (:value command) :value (:uri command))
+                      command)
+                  :binding (.toString binding))) :predicate)))
+           binders)
+
+
+      )))

@@ -273,14 +414,21 @@
                dc:title \"List of People\" ;
                dc:description \"A list of people contained within the application\" .

-ex:person-list data:haschild ex:person-name , ex:person-age , ex:pets-list .
+ex:person-list data:haschild ex:person-name , ex:person-age , ex:pets-list ,  ex:person-deleter .
+
+ex:person-deleter rdf:type data:deleter ;
+                  data:bindo rdf:type ;
+                  dc:title \"Remove\" ;
+                  dc:description \"Permanently delete a person from the database\" .

 ex:person-name rdf:type data:text-field ;
+               data:rank 5 ;
                data:bindo ont:name ;
                dc:title \"Name\" ;
                dc:description \"The name of a person\" .

 ex:person-age rdf:type data:text-field ;
+              data:rank 4 ;
               data:bindo ont:age ;
               dc:title \"Age\" ;
               dc:description \"The age of a person\".
@@ -390,7 +538,7 @@

 (def data-model (to-model data))

-(def broadcast-channel (channel))
+(def broadcast-channel (permanent-channel))
 (def edit (editor (to-model example-view)))

 (defn store [message]


Add gfx/image-mime

Add gfx/image-mime

--- src/multiplex/gfx.clj
+++ src/multiplex/gfx.clj
@@ -17,6 +17,13 @@
     (do
       (println (str "ERR: Reading size failed: " (str image)))
       [0 0]))))
+
+(defn image-mime
+  "returns the mime type of an image via the filename"
+  [filename]
+  (let [uri (java.net.URI. (str "file://" filename))
+        src (java.nio.file.Paths/get uri)]
+    (java.nio.file.Files/probeContentType src)))

 (defn needs-resize?
   [orig-sizes new-sizes]


Add `plet` syntactic abstaction for `all`.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -392,3 +392,15 @@
                                     `(bind ~r (fn [~l] ~acc)))
                                   `(pt/-promise (do ~@body))))))))

+#?(:clj
+   (defmacro plet
+     "A parallel let; executes all the bindings in parallel and
+     when all bindings are resolved, executes the body."
+     [bindings & body]
+     `(p/bind nil (fn [_#]
+                    ~(let [bindings (partition 2 bindings)]
+                       `(all ~(mapv second bindings)
+                             (fn [[~@(mapv first bindings)]]
+                               ~@body)))))))
+
+


Avoid use of *ns* because cljs

Avoid use of *ns* because cljs

--- test/cljc/fqcss/core_test.cljc
+++ test/cljc/fqcss/core_test.cljc
@@ -6,8 +6,8 @@
 (deftest test-pseudo-gensym-for-ns
   (testing "It should generate a gensym for every namespace"
     (fqcss/reset)
-    (is (= 'PG__1 (@#'fqcss.core/pseudo-gensym-for-ns (.getName *ns*))))
-    (is (= 'PG__1 (@#'fqcss.core/pseudo-gensym-for-ns (.getName *ns*))))
+    (is (= 'PG__1 (@#'fqcss.core/pseudo-gensym-for-ns 'fqcss.core-test)))
+    (is (= 'PG__1 (@#'fqcss.core/pseudo-gensym-for-ns 'fqcss.core-test)))
     (is (= 'PG__2 (@#'fqcss.core/pseudo-gensym-for-ns 'example-ns)))))

 (deftest test-resolve-kw


Document infix-term->dsl

Document infix-term->dsl

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -96,6 +96,10 @@
   (insta/parser (resource "infix-query-grammar.ebnf")))

 (defn ^:private infix-term->dsl
+  "Parses an infix term to DSL format.
+
+  This is different from parsed-infix->dsl because that will only accept full
+  queries, whereas this will parse individual terms in a query."
   [term]
   (m/match term
     [:fn-call


Fix whitespace at end of line

Fix whitespace at end of line

--- src/desdemona/utils.clj
+++ src/desdemona/utils.clj
@@ -18,7 +18,7 @@
     result
     (assert false)))

-(defn find-task
+(defn find-task
   "Finds the catalog entry where the :onyx/name key equals task-name"
   [catalog task-name]
   (let [matches (filter #(= task-name (:onyx/name %)) catalog)]