Refactor binary.clj

Refactor binary.clj

--- src/clojure_pf/core/binary.clj
+++ src/clojure_pf/core/binary.clj
@@ -14,8 +14,8 @@
         (.position index)
         (.limit (+ index size)))))

-(defn- deserialize-value [buffer entry]
-  "Deserializes a value from a buffer according to a form entry."
+(defn- deserialize-pair [buffer entry]
+  "Deserializes a key-value pair from a buffer according to a form entry."
   (let [kind          (:kind entry)
         [buffer
          array-ctor]  (case kind
@@ -27,48 +27,36 @@
                         :double [(.asDoubleBuffer buffer) double-array])
         remaining     (.remaining buffer)]
     (if (pos? remaining)
-      (case (form/entry->type entry)
-        :scalar (.get buffer)
-        :array  (let [size  (min (:size entry) remaining)
-                      array (array-ctor size)]
-                  (.get buffer array)
-                  array)))))
+      (let [field (:field entry)
+            value (case (form/entry->type entry)
+                    :scalar (.get buffer)
+                    :array  (let [size  (min (:size entry) remaining)
+                                  array (array-ctor size)]
+                              (.get buffer array)
+                              array))]
+        {field value}))))

-(defn- deserialize-payload [buffer region entries]
-  "Deserializes a packet payload according to a given region and form entries."
+(defn- deserialize-payload [buffer entries region]
+  "Deserializes a packet payload according to a form entry list and region."
   (let [buffer (regional-buffer buffer region)]
-    (loop [entries entries
-           payload {}]
-      (if (empty? entries)
-        payload
-        (let [entry (first entries)
-              value (deserialize-value buffer entry)]
-          (recur (rest entries)
-                 (assoc payload (:field entry) value)))))))
+    (->> entries
+         (map (partial deserialize-pair buffer))
+         (apply merge))))

 ; Deserialization exports

 (defn deserialize [raw-input-packet entries]
   "Deserializes one or more packets from a RawInputPacket according
   to given entries. Returns a list of destructured packets on success."
-  (let [buffer (-> raw-input-packet
-                   :data
-                   ByteBuffer/wrap
-                   .asReadOnlyBuffer)]
-    (loop [payload-regions  (:payload-regions raw-input-packet)
-           timestamps       (:timestamps raw-input-packet)
-           packets          []]
-      (if (empty? payload-regions)
-        packets
-        (let [payload-region  (first payload-regions)
-              timestamp       (first timestamps)
-              payload         (deserialize-payload buffer
-                                                   payload-region
-                                                   entries)
-              packet          (->Packet timestamp payload)]
-          (recur (rest payload-regions)
-                 (rest timestamps)
-                 (conj packets packet)))))))
+  (let [buffer          (-> (:data raw-input-packet)
+                            ByteBuffer/wrap
+                            .asReadOnlyBuffer)
+        timestamps      (:timestamps raw-input-packet)
+        payloads        (->> (:payload-regions raw-input-packet)
+                             (map (partial deserialize-payload
+                                           buffer
+                                           entries)))]
+    (map ->Packet timestamps payloads)))

 ; Serialization utiliies


Add authentication logic to the ui routing.

--- src/uxbox/ui.cljs
+++ src/uxbox/ui.cljs
@@ -1,45 +1,60 @@
 (ns uxbox.ui
   (:require [sablono.core :as html :refer-macros [html]]
+            [promesa.core :as p]
             [goog.dom :as gdom]
             [rum.core :as rum]
             [cats.labs.lens :as l]
             [uxbox.state :as s]
+            [uxbox.router :as r]
             [uxbox.rstore :as rs]
             [uxbox.data.projects :as dp]
-            [uxbox.ui.lightbox :as ui.lb]
-            [uxbox.ui.users :as users]
-            [uxbox.ui.dashboard :as dashboard]
+            [uxbox.ui.lightbox :as ui-lightbox]
+            [uxbox.ui.auth :as ui-auth]
+            [uxbox.ui.dashboard :as ui-dashboard]
             [uxbox.ui.workspace :refer (workspace)]
             [uxbox.ui.mixins :as mx]
             [uxbox.ui.shapes]))

-(def ^:static state
-  (as-> (l/select-keys [:location :location-params]) $
+(def ^:const auth-data
+  (as-> (l/key :auth) $
     (l/focus-atom $ s/state)))
+
+(def ^:const +unrestricted+
+  #{:auth/login})
+
+(def ^:const restricted?
+  (complement +unrestricted+))

 (defn app-render
   [own]
-  (let [{:keys [location location-params] :as state} (rum/react state)]
-    (case location
-      :auth/login (users/login)
-      :dashboard/projects (dashboard/projects-page)
-      :dashboard/elements (dashboard/elements-page)
-      :dashboard/icons (dashboard/icons-page)
-      :dashboard/colors (dashboard/colors-page)
-      :workspace/page (let [projectid (:project-uuid location-params)
-                            pageid (:page-uuid location-params)]
-                        (workspace projectid pageid))
-      nil
-      )))
+  (let [route (rum/react r/route-l)
+        auth (rum/react auth-data)
+        location (:id route)
+        params (:params route)]
+    (if (and (restricted? location) (not auth))
+      (do (p/schedule 0 #(r/go :auth/login)) nil)
+      (case location
+        :auth/login (ui-auth/login)
+        :dashboard/projects (ui-dashboard/projects-page)
+        :dashboard/elements (ui-dashboard/elements-page)
+        :dashboard/icons (ui-dashboard/icons-page)
+        :dashboard/colors (ui-dashboard/colors-page)
+        :workspace/page (let [projectid (:project-uuid params)
+                              pageid (:page-uuid params)]
+                          (workspace projectid pageid))
+        nil
+        ))))

 (def app
-  (mx/component {:render app-render
-                 :mixins [rum/reactive]
-                 :name "app"}))
+  (mx/component
+   {:render app-render
+    :mixins [rum/reactive]
+    :name "app"}))
+
 (defn init
   []
   (println "ui/init")
   (let [app-dom (gdom/getElement "app")
         lb-dom (gdom/getElement "lightbox")]
     (rum/mount (app) app-dom)
-    (rum/mount (ui.lb/lightbox) lb-dom)))
+    (rum/mount (ui-lightbox/lightbox) lb-dom)))


Code driven navigation.

Code driven navigation.

--- src/cornwalltechjam/layout.clj
+++ src/cornwalltechjam/layout.clj
@@ -4,8 +4,11 @@

 (def navigation-items
   [{:title "Home", :path "index.html"}
-   {:title "About Us", :path "about.html"}
-   {:title "Contact", :path "contact.html"}])
+   {:title "Photos from March 2016", :path "gallery_20160312.html"}
+   {:title "Photos from April 2016", :path "gallery_20160312.html"}
+   ;; {:title "Getting there", :path ".html"}
+   ;; {:title "Contact us", :path ".html"}
+   ])

 (defn- nav-props [item path]
   (let [props {}]
@@ -102,17 +105,7 @@
         [:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"}
          [:ul {:class "nav navbar-nav"}

-          [:li {:class "active"}
-           [:a {:href "index.html"} "Home"]]
-
-          [:li {:class ""}
-           [:a {:href "#"} "Getting there"]]
-
-          [:li {:class ""}
-           [:a {:href "gallery_20160312.html"} "Photo gallery"]]
-
-          [:li {:class ""}
-           [:a {:href "#"} "Contact us"]]
+          (navigation path)

           ]]]]


Processing of title page

Processing of title page

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -38,12 +38,11 @@
         (println "-> " user-name)
         user-name))

-(defn zw-mode?
+(defn get-title
     [request]
     (-> (:configuration request)
-        :server
-        :mode
-        (= "zw")))
+        :display
+        :app-name))

 (defn get-url-prefix
     [request]
@@ -52,7 +51,7 @@
         :url-prefix))

 (defn finish-processing
-    [request search-results message zw-mode]
+    [request search-results message title mode]
     (let [params        (:params request)
           cookies       (:cookies request)
           word          (get params "word")
@@ -62,18 +61,18 @@
         (println word)
         (println search-results)
         (if user-name
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix title mode))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix title mode))
                 (http-response/content-type "text/html")))))

 (defn process-front-page
-    [request zw-mode]
+    [request title]
     (let [params         (:params request)
           word           (get params "word")
           search-results (if (not (empty? word)) (db-interface/read-words-for-pattern word))]
-        (finish-processing request search-results nil zw-mode)))
+        (finish-processing request search-results nil title)))

 (defn store-word
     [word description user-name]
@@ -146,22 +145,22 @@
               (db-interface/undelete-word to-undelete))))

 (defn process-all-words
-    [request zw-mode]
+    [request title]
     (perform-operation request)
     (let [search-results (db-interface/read-all-words)]
-        (finish-processing request search-results nil zw-mode)))
+        (finish-processing request search-results nil title)))

 (defn process-deleted-words
-    [request zw-mode]
+    [request title]
     (perform-operation request)
     (let [search-results (db-interface/read-deleted-words)]
-        (finish-processing request search-results nil zw-mode)))
+        (finish-processing request search-results nil title)))

 (defn process-active-words
-    [request zw-mode]
+    [request title]
     (perform-operation request)
     (let [search-results (db-interface/read-active-words)]
-        (finish-processing request search-results nil zw-mode)))
+        (finish-processing request search-results nil title)))

 (defn read-changes-statistic
     []
@@ -176,7 +175,7 @@
     (db-interface/read-changes-for-user user-name))

 (defn process-user-list
-    [request zw-mode]
+    [request title]
     (let [changes-statistic (read-changes-statistic)
           changes           (read-changes)
           user-name         (get-user-name request)
@@ -184,24 +183,24 @@
         (println "stat"    changes-statistic)
         (println "changes" changes)
         (if user-name
-            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix title))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix title))
                 (http-response/content-type "text/html")))))

 (defn process-user-info
-    [request zw-mode]
+    [request title]
     (let [params            (:params request)
           selected-user     (get params "name")
           changes           (read-changes-for-user selected-user)
           user-name         (get-user-name request)
           url-prefix        (get-url-prefix request)]
         (if user-name
-            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix title))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix zw-mode))
+            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix title))
                 (http-response/content-type "text/html")))))

 (defn words->json
@@ -287,21 +286,21 @@
     [request]
     (println-and-flush "request URI: " (request :uri))
     (let [uri     (request :uri)
-          zw-mode (zw-mode? request)]
+          title   (get-title request)]
         (condp = uri
             "/favicon.ico"       (return-file "favicon.ico" "image/x-icon")
             "/bootstrap.min.css" (return-file "bootstrap.min.css" "text/css")
             "/smearch.css"       (return-file "smearch.css" "text/css")
             "/bootstrap.min.js"  (return-file "bootstrap.min.js" "application/javascript")
-            "/"                  (process-front-page    request zw-mode)
-            "/all-words"         (process-all-words     request zw-mode)
-            "/deleted-words"     (process-deleted-words request zw-mode)
-            "/active-words"      (process-active-words  request zw-mode)
+            "/"                  (process-front-page    request title)
+            "/all-words"         (process-all-words     request title)
+            "/deleted-words"     (process-deleted-words request title)
+            "/active-words"      (process-active-words  request title)
             "/add-word"          (process-add-word      request)
             ;"/find-words"       (process-find-words    request)
             "/add-words"         (process-add-words     request)
-            "/users"             (process-user-list     request zw-mode)
-            "/user"              (process-user-info     request zw-mode)
+            "/users"             (process-user-list     request title)
+            "/user"              (process-user-info     request title)
             "/wordlist/json"     (process-wordlist-json request)
             "/wordlist/text"     (process-wordlist-text request)
             "/wordlist/xml"      (process-wordlist-xml  request)


update test schema

update test schema

--- src/graphql_clj/validation.clj
+++ src/graphql_clj/validation.clj
@@ -112,23 +112,47 @@
   (assert (s/conform :graphql-clj/query parsed-query)))

 (comment
-  (def schema-str "schema {
-  query: Query
+  (def schema-str "enum DogCommand { SIT, DOWN, HEEL }
+
+type Dog implements Pet {
+  name: String!
+  nickname: String
+  barkVolume: Int
+  doesKnowCommand(dogCommand: DogCommand!): Boolean!
+  isHousetrained(atOtherHomes: Boolean): Boolean!
+  owner: Human
 }

-type Query {
-  a: A
-  x: X
+interface Sentient {
+  name: String!
 }

-type A {
-  b: B
+interface Pet {
+  name: String!
 }

-type B {
-  c(foo: Int): String
+type Alien implements Sentient {
+  name: String!
+  homePlanet: String
 }

-type X {
-  y(foo: Int): String
+type Human implements Sentient {
+  name: String!
+}
+
+enum CatCommand { JUMP }
+
+type Cat implements Pet {
+  name: String!
+  nickname: String
+  doesKnowCommand(catCommand: CatCommand!): Boolean!
+  meowVolume: Int
+}
+
+union CatOrDog = Cat | Dog
+union DogOrHuman = Dog | Human
+union HumanOrAlien = Human | Alien
+
+type QueryRoot {
+  dog: Dog
 }"))


timestamp to integer

timestamp to integer

--- src-clj/acha/db.clj
+++ src-clj/acha/db.clj
@@ -28,7 +28,7 @@
                           [:state :text]
                           [:sha1 :text]
                           [:reason :text]
-                          [:timestamp :text])
+                          [:timestamp "integer not null default 0"])
         "CREATE UNIQUE INDEX `url_unique` ON `repo` (`url` ASC)"
         (create-table-ddl :achievement
                           [:id "integer primary key autoincrement"]
@@ -44,10 +44,10 @@
         (logging/error e "Failed to initialize DB")))))

 (defn add-fake-data []
-  (insert! db :repo {:url "git@github.com:tonsky/datascript"})
-  (insert! db :repo {:url "git@github.com:tonsky/41-socks"})
-  (insert! db :repo {:url "git@github.com:tonsky/datascript-chat"})
-  (insert! db :repo {:url "git@github.com:tonsky/net.async"})
+  (insert! db :repo {:url "git@github.com:tonsky/datascript.git"})
+  (insert! db :repo {:url "git@github.com:tonsky/41-socks.git"})
+  (insert! db :repo {:url "git@github.com:tonsky/datascript-chat.git"})
+  (insert! db :repo {:url "git@github.com:tonsky/net.async.git"})
   (insert! db :user {:name "Anders Hovmöller" :email "boxed@killingar.net"})
   (insert! db :user {:name "Bobby Calderwood" :email "bobby_calderwood@mac.com"})
   (insert! db :user {:name "Kevin J. Lynagh"  :email "kevin@keminglabs.com"})
@@ -101,11 +101,11 @@

 (defn- get-next-repo []
   (first (query db ["select * from repo
-    where strftime('%s','now') - strftime('%s', timestamp) > 4*60*60 or timestamp is null
-    order by timestamp asc limit 1"])))
+    where ? - timestamp > 4*60*60
+    order by timestamp asc limit 1" (quot (System/currentTimeMillis) 1000)])))

 (defn- try-to-update [repo]
-  (update! db :repo {:timestamp (.toLocaleString (java.util.Date.))}
+  (update! db :repo {:timestamp (quot (System/currentTimeMillis) 1000)}
     ["id = ? and timestamp = ?" (:id repo) (:timestamp repo)]))

 (defn get-next-repo-to-process []


adding launch instructions

adding launch instructions

--- src/leiningen/new/figwheel.clj
+++ src/leiningen/new/figwheel.clj
@@ -48,7 +48,10 @@
                 :sanitized (name-to-path name)
                 :om? (om? opts)
                 :reagent? (reagent? opts)}]
-      (main/info "Generating fresh 'lein new' figwheel project.")
+      (main/info (str "Generating fresh 'lein new' figwheel project.\n\n"
+                      "Change in to your '" name "' directory and run 'lein figwheel'\n"
+                      "Wait for it to finish compiling\n"
+                      "Then open 'http://localhost:3449/index.html' in your browser"))
       (->files data
                ["README.md" (render "README.md" data)]
                ["project.clj" (render "project.clj" data)]


Fixed bug where uberwar task no longer excluded servlet-api-*.jar files.

Leiningen 2.0 references libraries directly out of your m2 repository
instead of your project's lib/ directory. JAR dependency calculations
assumed that these libraries pathnames only contained filenames, not
full absolute paths (e.g. "servlet-api.jar" vs.
"/home/achin/.m2/repository/javax/servlet/servlet-api/2.5/servlet-api.jar").

--- src/leiningen/ring/uberwar.clj
+++ src/leiningen/ring/uberwar.clj
@@ -13,11 +13,13 @@
     (->> (:library-path project) io/file .listFiles (map str))))

 (defn jar-dependencies [project]
-  (for [file (get-classpath project)
-        :when (and (.endsWith file ".jar")
+  (for [pathname (get-classpath project)
+        :let [file (io/file pathname)
+              fname (.getName file)]
+        :when (and (.endsWith fname ".jar")
                    ;; Servlet container will have it's own servlet-api impl
-                   (not (.startsWith file "servlet-api-")))]
-    (io/file file)))
+                   (not (.startsWith fname "servlet-api-")))]
+    file))

 (defn jar-entries [war project]
   (doseq [jar-file (jar-dependencies project)]


Only show rerun-from-start button for failed runs

--- src-cljs/frontend/components/pages/workflow.cljs
+++ src-cljs/frontend/components/pages/workflow.cljs
@@ -29,10 +29,14 @@
     :run-status/failed :status-class/failed
     :run-status/canceled :status-class/stopped))

-(defn- cancelable-status? [run-status]
-  (contains? #{:run-status/not-run
-               :run-status/running}
-             run-status))
+(def ^:private cancelable-statuses #{:run-status/not-run
+                                     :run-status/running})
+
+(def ^:private rerunnable-statuses #{:run-status/succeeded
+                                     :run-status/failed
+                                     :run-status/canceled})
+
+(def ^:private rerunnable-from-start-statuses #{:run-status/failed})

 (defn run-prs
   "A om-next compatible version of
@@ -168,20 +172,21 @@
                    :status-class/running (icon/status-running)
                    :status-class/waiting (icon/status-queued))]
                 [:.status-string (string/replace (name status) #"-" " ")]]]
-              (cond (cancelable-status? status)
+              (cond (cancelable-statuses status)
                     [:div.cancel-button {:on-click #(transact-run-cancel this id vcs-type org-name project-name)}
                      (icon/status-canceled)
                      [:span "cancel"]]
-                    (not (cancelable-status? status))
+                    (rerunnable-statuses status)
                     [:div.rebuild-button.dropdown
                      (icon/rebuild)
                      [:span "Rerun"]
                      [:i.fa.fa-chevron-down.dropdown-toggle {:data-toggle "dropdown"}]
                      [:ul.dropdown-menu.pull-right
-                      [:li
-                       [:a
-                        {:on-click #(transact-run-retry this id [])}
-                        "Rerun failed jobs"]]
+                      (when (rerunnable-from-start-statuses status)
+                        [:li
+                         [:a
+                          {:on-click #(transact-run-retry this id [])}
+                          "Rerun failed jobs"]])
                       [:li
                        [:a
                         {:on-click #(transact-run-retry this id jobs)}


refer to the app title with the correct ident

--- src/om_next_datascript_localisation_demo/components/app.cljs
+++ src/om_next_datascript_localisation_demo/components/app.cljs
@@ -35,7 +35,7 @@
       (log "-----------------------------")
       (log "App render:" props)
       (set-html-lang code)
-      (set-html-title (:app-title strings))
+      (set-html-title (:app/title strings))
       (html [:div

               (localised-string


some clojure work on say 7

some clojure work on say 7

--- src/advent/core.clj
+++ src/advent/core.clj
@@ -29,7 +29,7 @@
                 x
                 (recur (inc x))))))

-; advent #21
+; advent #21 (unfinshed and not working)
 (def boss {:hit-points 100 :damage 8 :armor 2})

 (def weapon-store {[4 0] 8
@@ -163,4 +163,38 @@
         santas-houses (process-directions-robo santas-directions)
         robos-houses (process-directions-robo robos-directions)
         houses-seen (union santas-houses robos-houses)]
-    (count houses-seen)))+    (count houses-seen)))
+
+
+; day 7
+; we need to define a local bit-not, since (bit-not 123) returns -124 and not 65412 as
+; needed for the problem
+(require '[clojure.string :as str])
+(def day-7-input "/Users/alandgraf/code/advent/day7.txt")
+
+(defn bit-not-unsigned
+  "An unsigned 16-bit Integer bitwise not"
+  [n]
+  (- 65535 n))
+
+
+
+
+(defn parse-output-wire [s]
+  (last (map str/trim (str/split s #"->"))))
+
+(defn parse-input-wires [s]
+  (first (map str/trim (str/split s #"->"))))
+
+(defn build-circuit
+  "returns map of circuit"
+  [circuit-input]
+  (reduce
+    (fn [acc next-circuit]
+      (let [output-wire (keyword (parse-output-wire next-circuit))
+            input-wires-str (parse-input-wires next-circuit)
+            input-wires (str/split input-wires-str #" ")]
+        (assoc acc output-wire input-wires)))
+    {}
+    circuit-input)
+  )


logging improvements

logging improvements

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -387,7 +387,12 @@
    (let [result (moreover-comp parent comp sem-impl)
          is-fail? (fail? result)]
      (if (not is-fail?)
-       (list result)))))
+       (do
+         (log/debug (str "overc: " (get-in parent [:rule]) "=>" (get-in comp [:rule]
+                                                                        (get-in comp [:synsem :sem :pred]
+                                                                                "(no pred for comp)"))))
+         ;; TODO: why are we returning a list here rather than just the result?
+         (list result))))))

 (defn overhc [parent head comp]
   (overc (overh parent head) comp))
@@ -435,7 +440,7 @@
             (let [[head comp] (if (= (:first parent) :head)
                                 [child1 child2]
                                 [child2 child1])]
-              (log/debug (str "over: parent: " (get-in parent [:rule]) " (" (get-in parent [:schema-symbol]) "); heads:["
+              (log/trace (str "over: parent: " (get-in parent [:rule]) " (" (get-in parent [:schema-symbol]) "); heads:["
                               (string/join ","
                                            (map (fn [h]
                                                   (get-in h [:rule]


Privatize block constructor.

Privatize block constructor.

--- src/blocks/data.clj
+++ src/blocks/data.clj
@@ -229,7 +229,7 @@
 ;; ## Constructors

 ;; Remove automatic constructor function.
-(ns-unmap *ns* '->Block)
+(alter-meta! #'->Block assoc :private true)

 (defn lazy-block
@@ -238,7 +238,7 @@
   given the id and size directly, without being checked."
   ^blocks.data.Block
   [id size reader]
-  (Block. id size nil reader nil nil))
+  (->Block id size nil reader nil nil))

 (defn literal-block
@@ -248,7 +248,7 @@
   [id source]
   (let [content (collect-bytes source)]
     (when (pos? (count content))
-      (Block. id (count content) content nil nil nil))))
+      (->Block id (count content) content nil nil nil))))

 (defn read-block
@@ -258,18 +258,18 @@
   (let [hash-fn (checked-hasher algorithm)
         content (collect-bytes source)]
     (when (pos? (count content))
-      (Block. (hash-fn (.open content)) (count content) content nil nil nil))))
+      (->Block (hash-fn (.open content)) (count content) content nil nil nil))))

 (defn clean-block
   "Creates a version of the given block without extra attributes or metadata."
   [^Block block]
-  (Block. (.id block)
-          (.size block)
-          (.content block)
-          (.reader block)
-          nil
-          nil))
+  (->Block (.id block)
+           (.size block)
+           (.content block)
+           (.reader block)
+           nil
+           nil))

 (defn merge-blocks
@@ -282,9 +282,9 @@
     (throw (IllegalArgumentException.
              (str "Cannot merge blocks with differing ids " (.id a)
                   " and " (.id b)))))
-  (Block. (.id b)
-          (.size b)
-          (.content b)
-          (.reader b)
-          (not-empty (merge (._attrs a) (._attrs b)))
-          (not-empty (merge (._meta  a) (._meta  b)))))
+  (->Block (.id b)
+           (.size b)
+           (.content b)
+           (.reader b)
+           (not-empty (merge (._attrs a) (._attrs b)))
+           (not-empty (merge (._meta  a) (._meta  b)))))


render canvas to gif

render canvas to gif

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -225,11 +225,13 @@
       (swap! app-state assoc :media-error? true)))))

-(defn make-gif [imgs ms]
-  (let [gif (js/GIF. #js {:workerScript "/js/gif.worker.js"})]
+(defn make-gif [app ms]
+  (let [gif    (js/GIF. #js {:workerScript "/js/gif.worker.js" :quality 1})
+        canvas (.-canvas playback-ctx)]
     (go
-      (doseq [frame imgs]
-        (.addFrame gif (<! frame) #js {:delay ms}))
+      (dotimes [i (count (:moves app))]
+        (<! (paint-canvas! app i))
+        (.addFrame gif canvas #js {:delay ms}))
       (.on gif "finished" #(js/open (.createObjectURL js/URL %)))
       (.render gif))))

@@ -311,7 +313,7 @@

             (when stream
               (dom/div nil
-                (dom/button #js {:onClick #(make-gif @img-cache tick-ms)} "make gif")
+                (dom/button #js {:onClick #(make-gif app tick-ms)} "make gif")

                 (dom/label
                   #js {:className "move-count"}


syntax tweaks

syntax tweaks

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -220,7 +220,7 @@
                 :vid-offset  (* 100 (/ (max 1 (.abs js/Math (- vw vh))) (max 1 (* vw 2))))
                 :canvas-node canvas
                 :ctx         (.getContext canvas "2d")
-                :show-about?  true})
+                :show-about? true})
               (js/setTimeout start! 500))))
           (aset "src" data)))
       (swap! app-state assoc :media-error data)))))
@@ -233,8 +233,9 @@
       (dotimes [idx (count (:moves app))]
         (<! (paint-canvas! app idx))
         (.addFrame gif canvas #js {:delay ms :copy true}))
-      (.on gif "finished" #(om/update! app :result-gif (.createObjectURL js/URL %)))
-      (.render gif))))
+      (doto gif
+        (.on "finished" #(om/update! app :result-gif (.createObjectURL js/URL %)))
+        (.render)))))

 (defn modal [{:keys [stream media-error show-about? result-gif cells win-state grid-size] :as app}]


Tighten up

Tighten up

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -63,8 +63,7 @@
   }
   var prefix = findPrefix();
   var loadedSrcs = {};
-  var scripts;
-  scripts = document.getElementsByTagName('script');
+  var scripts = document.getElementsByTagName('script');
   for (var i = 0; i < scripts.length; i++) {
     if (scripts[i].src !== undefined) {
       loadedSrcs[scripts[i].src] = true;
@@ -81,7 +80,7 @@
         document.getElementsByTagName('head')[0].appendChild(newElem);
       }
     }
-  };
+  }
 %s%s
 window.__boot_cljs_shim_loaded = true;
 })();


Extract check whether to skip automated comparison to separate function.

--- test/clj/quil/snippet.clj
+++ test/clj/quil/snippet.clj
@@ -15,6 +15,18 @@
 (def tests-in-set 50)
 (def current-test (atom -1))

+(defn skip-automated-compare? [snippet-name]
+  (contains? #{"current-frame-rate-target-frame-rate"
+               "noise"
+               "noise-detail"
+               "random-2d"
+               "random-3d"
+               "random"
+               "random-gaussian"
+               "resize-sketch"
+               "save"
+               "time-and-date"} snippet-name))
+
 (defn- compare-images [expected actual difference]
   (let [{:keys [err]} (sh/sh "compare" "-metric" "mae" expected actual difference)
         result        (second (re-find #"\((.*)\)" err))]
@@ -24,15 +36,7 @@
   (string/replace file-name #"(\w+)\.(\w+)$" (str suffix ".$2")))

 (defn assert-unchanged-snippet-output [name]
-  (when-not (contains? #{"current-frame-rate-target-frame-rate"
-                         "noise"
-                         "noise-detail"
-                         "random-2d"
-                         "random-3d"
-                         "random"
-                         "random-gaussian"
-                         "resize-sketch"
-                         "time-and-date"} name)
+  (when-not (skip-automated-compare? name)
     (let [n          (str "snippet-snapshots/clj/" name)
           _          (q/save (str "resources/" n "-actual.png"))
           expected   (.getAbsolutePath (io/file (io/resource (str n "-expected.png"))))


no more fntest. fntest was not fn.

no more fntest. fntest was not fn.

--- test/gangway/web_test.clj
+++ test/gangway/web_test.clj
@@ -3,7 +3,6 @@
             [clj-http.client :as http]
             [immutant.messaging :as msg]
             [immutant.util]
-            [fntest.core :as fnt]
             [clojure.data.json :as json]
             [gangway.util :as gw-util]
             [gangway.web :as gw-web]))


fixed broken tests

fixed broken tests

--- test/rester/core_test.clj
+++ test/rester/core_test.clj
@@ -1,7 +1,9 @@
 (ns rester.core-test
   (:require [clojure.data.xml :refer [parse-str sexp-as-element]]
             [clojure.test :refer :all]
-            [rester.core :refer :all])
+            [rester.core
+             :refer
+             [cyclic? diff* extract-data parse-date-exp str->map]])
   (:import java.text.SimpleDateFormat
            java.util.Date))


lazy load jvm metrics

lazy load jvm metrics

--- src/celestial/health.clj
+++ src/celestial/health.clj
@@ -12,7 +12,7 @@
         (health/healthy "%d is less than 30!" now)
         (health/unhealthy "%d is more than 30!" now)))))

-(clojure.pprint/pprint (.getMetrics default-registry))
-(clojure.pprint/pprint (health/check second-check))
-
-; (instrument-jvm)
+(let [m (.getMetrics default-registry)]
+  (when (or (nil? m) (not (get m "jvm.thread.deadlock.count")))
+    (instrument-jvm)
+    ))


try to run ci3

try to run ci3

--- src/ci3/server/watch.clj
+++ src/ci3/server/watch.clj
@@ -81,6 +81,7 @@
             (reset-version (:resource opts))
             (retry))
         (do #_(println opts " for v:" (get-in res [:object :metadata :resourceVersion]))
+            (log/info res)
             #_(println "->" (:handler opts))
             (u/*apply (:handler opts) {:env env :resource (k8s/resolve-secrets res)}))))
     [body :continue]))
@@ -150,7 +151,7 @@
   (supervisor {:kube-url "http://localhost:8001"})
   (start
    {:env {:kube-url "http://localhost:8001"}
-    :watch {:timeout 5000
+    :watch {:timeout 500
             :resources [{:handler :ci3.watch/repository
                          :apiVersion "ci3.io/v1"
                          :resource :repositories


cljs.closure/output-one-file should mkdirs for output-to

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1025,7 +1025,9 @@
     (nil? output-to) js

     (string? output-to)
-    (spit output-to js)
+    (do
+      (util/mkdirs output-to)
+      (spit output-to js))

     :else (println js)))


Make dropdown links work more reliably

Make dropdown links work more reliably

--- src/cljs/drawer/gui.cljs
+++ src/cljs/drawer/gui.cljs
@@ -48,12 +48,12 @@
                 (if (= active name)
                   (func :none)
                   (let [f #(do (func :none)
-                               (set! (.-onmousedown js/window) nil)
+                               (set! (.-onmouseup js/window) nil)
                                ;; Reset the cursor to default after the
                                ;; pointer hack has done its job
                                (set! (-> js/document .-body .-style .-cursor) nil))]
                     (do (func name)
-                        (set! (.-onmousedown js/window) f)
+                        (set! (.-onmouseup js/window) f)
                         ;; Hack for iOS only accepting MouseEvent input
                         ;; from cursor:pointer/'clickable' elements
                         (set! (-> js/document .-body .-style .-cursor) "pointer")))))))


normalize movement

normalize movement

--- src/cljs/mpd/player.cljs
+++ src/cljs/mpd/player.cljs
@@ -47,7 +47,9 @@
           y (:y player)
           speed (:speed player)
           dx (if (:left @input) (- speed) (if (:right @input) speed 0))
-          dy (if (:up @input) (- speed) (if (:down @input) speed 0))]
-      (when (not (= dy 0)) (swap! state assoc-in [:player :y] (+ y dy)))
-      (when (not (= dx 0)) (swap! state assoc-in [:player :x] (+ x dx))))
+          dy (if (:up @input) (- speed) (if (:down @input) speed 0))
+          ndx (if (and (not (= dx 0)) (not (= dy 0))) (* dx 0.7071) dx)
+          ndy (if (and (not (= dx 0)) (not (= dy 0))) (* dy 0.7071) dy)]
+      (when (not (= dy 0)) (swap! state assoc-in [:player :y] (+ y ndy)))
+      (when (not (= dx 0)) (swap! state assoc-in [:player :x] (+ x ndx))))
     state))


Clojure has case!?!

Clojure has case!?!

--- src/cljx/transom/ot.cljx
+++ src/cljx/transom/ot.cljx
@@ -6,29 +6,29 @@

 (defn count-op
   [[o p]]
-  (match [o]
-    [:=] p
-    [:-] p
-    [:+] (count p)))
+  (case o
+    := p
+    :- p
+    :+ (count p)))

 (defn count-before
   [edit]
   (reduce
-    (fn [c op]
-      (match [op]
-        [[:= p]] (+ c p)
-        [[:- p]] (+ c p)
-        [[:+ p]] c))
+    (fn [c [o p]]
+      (case o
+        := (+ c p)
+        :- (+ c p)
+        :+ c))
     0 edit))

 (defn count-after
   [edit]
   (reduce
-    (fn [c op]
-      (match [op]
-        [[:= p]] (+ c p)
-        [[:- p]] c
-        [[:+ p]] (+ c (count p))))
+    (fn [c [o p]]
+      (case o
+        := (+ c p)
+        :- c
+        :+ (+ c (count p))))
     0 edit))

 (defn apply-edit
@@ -90,7 +90,7 @@
         :else
         (let [[o1 p1] op1
               [o2 p2] op2]
-          (condp = (compare p1 p2)
+          (case (compare p1 p2)
             -1 (recur (rest edit1)
                       (cons [o2 (- p2 p1)] (rest edit2))
                       (conj out [op1 [o2 p1]]))
@@ -142,7 +142,7 @@
         (let [[o1 p1] op1
               p1' (if (string? p1) (count p1) p1)
               [o2 p2] op2]
-          (condp = (compare p1' p2)
+          (case (compare p1' p2)
             -1
             (recur (rest edit1) (cons [o2 (- p2 p1')] (rest edit2))
                    (conj out [op1 [o2 p1']]))
@@ -179,12 +179,13 @@
   ;; caret is the little blinky line thing
   ;; index is where we are in the document
   (assert (<= caret (count-before edit)))
-  (loop [caret caret index 0 edit edit]
+  (loop [caret caret, index 0, edit edit]
     (if (<= caret index) ;; < ?
       caret
       (let [op (first edit)
-            caret' (cond
-                     (= := (first op)) caret
-                     (= :- (first op)) (- caret (second op))
-                     (= :+ (first op)) (+ caret (count (second op))))]
-        (recur caret' (+ index (count-op op)) (rest edit))))))
+            caret (case (first op)
+                    := caret
+                    :- (- caret (second op))
+                    :+ (+ caret (count (second op))))
+            index (+ index (count-op op))]
+        (recur caret index (rest edit))))))


Use compojure /api handler

Use compojure /api handler

--- server/src/spira/rest_adapter/routes.clj
+++ server/src/spira/rest_adapter/routes.clj
@@ -78,4 +78,4 @@

 (def app
-  (-> (handler/site app-routes)))
+  (-> (handler/api app-routes)))


refactor weight matrix generation

refactor weight matrix generation

--- src/cortex/util.clj
+++ src/cortex/util.clj
@@ -45,6 +45,11 @@
           m (long m)
           factor (Math/sqrt (/ 1.0 n))]
       (m/scale! (rand/sample-normal [m n]) factor))))
+
+(defn random-matrix
+  "Constructs an array of the given shape with random normally distributed element values"
+  ([shape-vector]
+    (rand/sample-normal shape-vector)))

 (defn mse-gradient-fn
   "Returns the MSE error gradient for a given output and target value"
@@ -140,10 +145,3 @@
                                 (Math/abs (+ gradient numeric-gradient)))]
           relative-error))
       (range (m/column-count input)))))
-
-(defn random-matrix
-  "Constructs an array of the given shape with random normally distributed element values"
-  ([shape-vector]
-    (if (> (count shape-vector) 1 )
-      (apply weight-matrix shape-vector)
-      (rand/sample-normal (first shape-vector)))))


newer fix computes positions upwards in a dom tree

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -429,7 +429,8 @@
                                                     (apply
                                                      map vector poss)))

-                                accum-scr      (into [] (reductions * positions-freq))
+                                accum-scr      (reverse
+                                                (into [] (reductions * (reverse positions-freq))))

                                 where          (utils/positions-at
                                                 (map


disable flaky tests (#578)

disable flaky tests (#578)

--- waiter/integration/waiter/async_request_integration_test.clj
+++ waiter/integration/waiter/async_request_integration_test.clj
@@ -187,7 +187,8 @@
             (assert-response-status response 200))))
       (delete-service waiter-url service-id))))

-(deftest ^:parallel ^:integration-slow ^:resource-heavy test-multiple-async-requests
+; Marked explicit because it's flaky. Disabled tests are documented and will be fixed
+(deftest ^:parallel ^:integration-slow ^:resource-heavy ^:explicit test-multiple-async-requests
   ;; tests the metrics and state flow associated with a multiple concurrent async requests.
   (testing-using-waiter-url
     (let [metrics-sync-interval-ms (-> (waiter-settings waiter-url)


[UI] fix svg path error

[UI] fix svg path error


Surrogate's body can be optional

Surrogate's body can be optional

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -43,11 +43,13 @@
       (.push js-array child))
     js-array))

-(defn surrogate [object header]
-  (js-obj
-    surrogate-key true
-    "target" object
-    "header" header))
+(defn surrogate
+  ([object header] (surrogate object header true))
+  ([object header has-body] (js-obj
+                              surrogate-key true
+                              "target" object
+                              "header" header
+                              "hasBody" has-body)))

 (defn nil-template [_]
   (template span "color:#808080" "nil"))
@@ -191,7 +193,7 @@

 (defn has-body-api-call [value]
   (if (surrogate? value)
-    true
+    (.-hasBody value)
     (abbreviated? (build-header value))))

 (defn body-api-call [value]


fixed obsolete comment

fixed obsolete comment

--- src/distillery/tasks.clj
+++ src/distillery/tasks.clj
@@ -24,7 +24,7 @@
 (defn map-fn
   "This HOF returns the map function that should be
   used for time consuming transformations.
-  The configuration var `distillery.configuration/parallel-proc`
+  The configuration value `:parallel-proc`
   controls whether `pmap` or `map` is returned."
   []
   (if (cfg/value :parallel-proc)


Remove file based ops.

Remove file based ops.

--- src/error_codes/core.clj
+++ src/error_codes/core.clj
@@ -209,53 +209,6 @@
    extract-insertion-errors
    extract-deletion-errors])

-(use 'clojure.java.io)
-(defn get-files-sorted [dir]
-  (->> (file-seq (file dir))
-       rest
-       (sort-by #(.getName  %))))
-#_(file-locations for now... "/home/kima/programming/ocr-visualizer/resources/public/ground-truth/" "/home/kima/programming/ocr-visualizer/resources/public/edits," "/home/kima/programming/ocr-visualizer/resources/public/ocr-results/")
-
-(defn deploy-to-ocr-visualizer []
-  (let [gts (get-files-sorted "/home/kima/programming/ocr-visualizer/resources/public/ground-truth/")
-        ocr-res (get-files-sorted "/home/kima/programming/ocr-visualizer/resources/public/ocr-results/")]
-    (doall (pmap (fn [gt ocr]
-                   (let [filename (str "/home/kima/programming/ocr-visualizer/resources/public/edits/" (.getName gt))]
-                     (prn "error-counts for " filename)
-                     (spit filename (pr-str (error-codes (slurp gt) (slurp ocr))))))
-                 gts ocr-res))))
-
-
-(defn deploy-error-codes [base-directory]
-  (let [gts (get-files-sorted (file base-directory "ground-truth/"))
-        ocr-res (get-files-sorted (file base-directory "ocr-results/"))]
-    (doall (pmap (fn [gt ocr]
-                   (let [filename (file base-directory
-                                        "edits/" (.getName gt))]
-                     (prn "error-counts for " filename)
-                     (spit filename (pr-str (error-codes (slurp gt) (slurp ocr))))))
-                 gts ocr-res))))
-
-(def base-directories
-  ["/home/kima/programming/grenzbote-files/grenzbote/abby"
-   "/home/kima/programming/grenzbote-files/grenzbote/recognition-server_output_mit-woerterbuch"
-   "/home/kima/programming/grenzbote-files/grenzbote/recognition-server_output_mit-woerterbuch_2014-07-16"
-   "/home/kima/programming/grenzbote-files/grenzbote/recognition-server_output_ohne-woerterbuch"
-   "/home/kima/programming/grenzbote-files/grenzbote/recognition-server_output_ohne-woerterbuch_2014-07-16"
-   "/home/kima/programming/grenzbote-files/grenzbote/tesseract_trainiert_gem"
-   "/home/kima/programming/grenzbote-files/grenzbote/tesseract_untrainiert"
-   "/home/kima/programming/grenzbote-files/grenzbote/Wikisource-erster-Band"
-   "/home/kima/programming/grenzbote-files/grenzbote/Wikisource-erster-Band_2014-07-16"
-   "/home/kima/programming/grenzbote-files/grenzbote/statistic-test"
-   "/home/kima/programming/grenzbote-files/grenzbote/new-test"
-   "/home/kima/programming/grenzbote-files/grenzbote/abby_verbessert"
-   ])
-
-(defn deploy-base-direcories []
-  (doseq [bd base-directories]
-    (prn "<<<<<<<<<<<<<<<<<now " bd ">>>>>>>>>>>>>>>>>>")
-    (deploy-error-codes bd)))
-
 (defn word-count [text]
   (as-> text x
         (.split x "\\s*")
@@ -407,7 +360,7 @@
 (defn generate-correction-statistics
   ([base-directory-unverbessert base-directory-verbessert]
      (generate-correction-statistics base-directory-unverbessert base-directory-verbessert [strip-newline-errors strip-start-and-end-errors]))
-  ([base-directory-unverbessert base-directory-verbessert filters]
+  ([base-directory-unverbessert base-directory-verbessert filters]
      (let [gts (get-files-sorted (file base-directory-unverbessert "ground-truth/"))
            gt-text (map slurp gts)
            ocr-res-unverb (map slurp (get-files-sorted (file base-directory-unverbessert "ocr-results/")))


new version of s3 task

new version of s3 task

--- build.boot
+++ build.boot
@@ -22,7 +22,7 @@
     :bucket "blog.hashobject.com"
     :access-key (System/getenv "AWS_ACCESS_KEY")
     :secret-key (System/getenv "AWS_SECRET_KEY")
-    :source "target/public"
+    :source "public"
     :options {"Cache-Control" "max-age=315360000, no-transform, public"}})

 (deftask build-dev


Initialize bootlaces

Initialize bootlaces

--- build.boot
+++ build.boot
@@ -19,6 +19,8 @@
       :license     {"Eclipse Public License"
                     "http://www.eclipse.org/legal/epl-v10.html"}})

+(bootlaces! version)
+
 (deftask build
   "Build and install the project locally."
   []


Replaced sequencer toggle buttons with custom grid.

This avoids focus drawing issues in OSX L&F. Also, you can drag the
mouse over the grid to fill it in. Hold down shift to turn cells off.
Still needs a lot of polish, but I think it's more usable already.

--- src/overtone/gui/sequencer.clj
+++ src/overtone/gui/sequencer.clj
@@ -2,59 +2,126 @@
   (:use [overtone.sc server]
         [overtone.music time]
         [overtone.gui.control :only [synth-controller]]
-        [seesaw core mig border]
+        [seesaw core]
+        [seesaw.color :only [color]]
+        [seesaw.graphics :only [style draw rounded-rect line]]
         [seesaw.swingx :only [hyperlink]])
   (:require [seesaw.bind :as bind]))

 (defn- make-initial-state [metro steps instruments]
   {:playing?  false
    :metronome metro
+   :steps     steps
    :step      0
-   :rows      (into
-                {}
+   :rows      (vec
                 (for [i instruments]
-                  [(:name i) (vec (repeat steps false))]))})
+                  { :inst i
+                    :value (vec (repeat steps false))}))
+   })

 (defn- toggle-playing [state]
   (update-in state [:playing?] not))

-(defn- set-step-state [state step-vec inst]
-  (assoc-in state [:rows (:name inst)] step-vec))
+(defn- toggle-entry [state row col]
+  (update-in state [:rows row :value col] not))
+
+(defn- set-entry [state row col v]
+  (assoc-in state [:rows row :value col] v))
+
+(defn- get-entry [state row col]
+  (get-in state [:rows row :value col]))
+
+(defn- clear-row [state row]
+  (assoc-in state [:rows row :value] (vec (repeat (:steps state) false))))

 (defn- step-player
-  [state-atom beat steps instruments]
+  [state-atom beat]
   (let [state @state-atom]
     (when (:playing? state)
       (let [metro (:metronome state)
+            steps (:steps state)
             index (mod beat steps)
-            next-beat (inc beat)]
+            next-beat (inc beat) ]
         (swap! state-atom assoc-in [:step] index)
-        (doseq [inst instruments]
-          (when (nth (get-in state [:rows (:name inst)]) index)
+        (doseq [{:keys [inst value]} (:rows state)]
+          (when (nth value index)
             (at (metro beat) (inst))))
         (apply-at (metro next-beat) #'step-player
-                  [state-atom next-beat steps instruments])))))
+                  [state-atom next-beat])))))

-(defn- step-row
-  [ins steps state-atom]
-  (let [ins-btn (hyperlink :text (:name ins) :tip "Click for synth controls")
-        btns (repeatedly steps #(toggle :selected? false))
-        btns-constrained (map (fn [b] [b "width 25:25:25"]) btns)
-        clear (button :text "clear"
-                      :tip "Clear this row") ]
-    ; Route changes in buttons to changes in state vector for row
-    (bind/bind
-      (apply bind/funnel btns)
-      (bind/b-swap! state-atom set-step-state ins))
+(def ^{:private true} grid-line-style
+  (style :foreground "#55F" :stroke 1.0 :cap :round))

-    ; inst buttons open controls
-    (listen ins-btn :action (fn [_] (synth-controller ins)))
-    ; Clear button unselects the row
-    (listen clear :action (fn [_] (config! btns :selected? false)))
+(def ^{:private true} enabled-entry-style
+  (style
+    :stroke 1.0
+    :background (color 0 255 0 200)
+    :foreground (color 0 150 0)))

-    (concat [[ins-btn "growx, gap 5px, gapright 10px"]]
-            btns-constrained
-            [[clear "gapleft 10px"]])))
+(def ^{:private true} current-step-style
+  (style
+    :stroke 1.0
+    :background (color 128 128 224 200)
+    :foreground (color 0 150 0)))
+
+(defn- paint-grid [state ^javax.swing.JComponent c g]
+  (let [w    (width c)
+        h    (height c)
+        rows (count (:rows state))
+        cols (:steps state)
+        step (:step state)
+        dy   (/ h rows)
+        dx   (/ w cols)]
+    (if (:playing? state)
+      (let [x (* step dx)]
+        (draw g (rounded-rect x 0 dx h) current-step-style)))
+    (dotimes [r rows]
+      (let [y (* r dy)]
+        (draw g (line 0 y w y) grid-line-style)
+        (dotimes [c cols]
+          (let [x (* c dx)]
+            (draw g (line x 0 x h) grid-line-style)
+            (when (get-entry state r c)
+              (draw g
+                    (rounded-rect (+ x 2) (+ y 2) (- dx 3) (- dy 3) 3 3)
+                    enabled-entry-style))))))))
+
+(defn- on-grid-clicked [state e]
+  (let [grid (to-widget e)
+        x    (.getX e)
+        y    (.getY e)
+        rows (count (:rows state))
+        cols (:steps state)
+        c    (int (/ x (/ (width grid) cols)))
+        r    (int (/ y (/ (height grid) rows)))]
+    (toggle-entry state r c)))
+
+(defn- on-grid-drag [state e]
+  (let [grid (to-widget e)
+        x    (.getX e)
+        y    (.getY e)
+        rows (count (:rows state))
+        cols (:steps state)
+        c    (int (/ x (/ (width grid) cols)))
+        r    (int (/ y (/ (height grid) rows)))]
+    (set-entry state r c (not (.isShiftDown e)))))
+
+(defn- step-grid [state-atom]
+  (let [state @state-atom
+
+        c (canvas :background :darkgrey
+                  :paint #(paint-grid @state-atom %1 %2)
+                  :preferred-size [(* 25 (:steps state))
+                                   :by
+                                   (* 25 (count (:rows state)))])]
+    (listen c :mouse-clicked #(swap! state-atom on-grid-clicked %)
+              :mouse-dragged #(swap! state-atom on-grid-drag %))
+    c))
+
+(defn- inst-button
+  [inst]
+  (hyperlink :text (:name inst)
+             :listen [:action (fn [e] (synth-controller inst))]))

 (defn step-sequencer
   [metro steps & instruments]
@@ -63,38 +130,31 @@
           play-btn     (button :text "play")
           bpm-spinner  (spinner :model (spinner-model (metro :bpm) :from 20 :to 300 :by 1)
                                 :maximum-size [60 :by 100])
-          step-lbls    (vec (for [i (range steps)] (label :size [25 :by 25]
-                                                          :background "#22F"
-                                                          :opaque? false
-                                                          :border (line-border :color "#22A"))))
           control-pane (toolbar :floatable? false
                                 :items [play-btn
                                         :separator
                                         bpm-spinner
                                         [:fill-h 5]
                                         "bpm"])
-          seq-pane     (mig-panel :constraints [(str "wrap " (+ 2 steps)) "" ""]
-                                  :items (concat
-                                           [[(label :text "step") "growx, gap 5px, gapright 10px"]]
-                                              (for [lbl step-lbls] [lbl "width 25:25:25"])
-                                              [["" ""]]
-                                           (mapcat #(step-row % steps state-atom) instruments)))
+          grid         (step-grid state-atom)
+          inst-btns    (map inst-button instruments)
           f (frame :title    "Sequencer"
-                   :content  (border-panel :north control-pane :center seq-pane)
+                   :content  (border-panel
+                               :border 5 :hgap 5 :vgap 5
+                               :north control-pane
+                               :west (grid-panel :columns 1
+                                                 :items inst-btns)
+                               :center grid)
                    :on-close :dispose)]
       (bind/bind bpm-spinner (bind/b-do [v] (metro :bpm v)))
-      (bind/bind
-        state-atom
-        (bind/b-do [{:keys [step]}]
-                   (config! step-lbls :opaque? false)
-                   (config! (step-lbls step) :opaque? true)
-                   (repaint! step-lbls)))
+      (bind/bind state-atom (bind/b-do [v] (repaint! grid)))
+
       (listen play-btn :action
               (fn [e]
                 (let [playing? (:playing? (swap! state-atom toggle-playing))]
                   (config! play-btn :text (if playing? "stop" "play"))
                   (if playing?
-                    (step-player state-atom (metro) steps instruments)))))
+                    (step-player state-atom (metro))))))

       (with-meta {:frame (-> f pack! show!)
                   :state state-atom }


refactor handlers

refactor handlers

--- src/piraspbay/handlers/api.clj
+++ src/piraspbay/handlers/api.clj
@@ -16,32 +16,30 @@
         address (-> req :remote-addr)]
     (ping name key address (time/now))))

-(defn profile [req]
-  (let [me (-> req :params :me)
-        name (-> req :params :user)
-        user (db/find-user name)]
-    (user-json user)))
+(defn auth [handler]
+  (fn [req] (handler req (-> req :params :me))))

-(defn friend [req]
-  (let [me (-> req :params :me)]
-    (map user-json (db/find-friends me))))
+(def profile (auth (fn [req me]
+                     (let [name (-> req :params :user)
+                           user (db/find-user name)]
+                       (user-json user)))))

-(defn request [req]
-  (let [me (-> req :params :me)]
-       (db/find-requests me)))
+(def get-config (auth (fn [req me] "config!")))
+
+(def friend (auth (fn [req me]
+                    (map user-json (db/find-friends me)))))
+
+(def request (auth (fn [req me] (db/find-requests me))))

-(defn accept [req]
-  (let [me (-> req :params :me)
-        user (-> req :params :user)]
-    (if (db/accept-request me user) "ok" "ko")))
+(def accept (auth (fn [req me]
+                    (let [user (-> req :params :user)]
+                      (if (db/accept-request me user) "ok" "ko")))))

-(defn delete [req]
-  (let [me (-> req :params :me)
-        user (-> req :params :user)]
-    [me user]))
+(def delete (auth (fn [req me]
+                    (let [user (-> req :params :user)]
+                      [me user]))))

-(defn new-request [req]
-  (let [me (-> req :params :me)
-        user (-> req :params :user)]
-    [me user]))
+(def new-request (auth (fn [req me]
+                         (let [user (-> req :params :user)]
+                           [me user]))))


Cleaned up eagerness and various map constructions in conv update graph

--- src/polismath/conversation.clj
+++ src/polismath/conversation.clj
@@ -177,9 +177,8 @@
      base-conv-update-graph
      {:mat (plmb/fnk [rating-mat]
              ; swap nils for zeros - most things need the 0s, but repness needs the nils"
-             (greedy
-               (map (fn [row] (map #(if (nil? %) 0 %) row))
-                 (get-matrix rating-mat))))
+             (mapv (fn [row] (map #(if (nil? %) 0 %) row))
+               (get-matrix rating-mat)))

       :pca (plmb/fnk [conv mat opts']
              (wrapped-pca mat (:n-comps opts')
@@ -189,20 +188,16 @@
       :proj (plmb/fnk [rating-mat pca]
               (sparsity-aware-project-ptpts (get-matrix rating-mat) pca))

-;      :proj (plmb/fnk [mat pca]
-              ;(pca-project mat pca))
-
       :base-clusters
             (plmb/fnk [conv rating-mat proj in-conv opts']
-              (greedy
-                (let [proj-mat
-                        (named-matrix (rownames rating-mat) ["x" "y"] proj)
-                      in-conv-mat (rowname-subset proj-mat in-conv)]
-                  (sort-by :id
-                    (kmeans in-conv-mat
-                      (:base-k opts')
-                      :last-clusters (:base-clusters conv)
-                      :cluster-iters (:base-iters opts'))))))
+              (let [proj-mat
+                      (named-matrix (rownames rating-mat) ["x" "y"] proj)
+                    in-conv-mat (rowname-subset proj-mat in-conv)]
+                (sort-by :id
+                  (kmeans in-conv-mat
+                    (:base-k opts')
+                    :last-clusters (:base-clusters conv)
+                    :cluster-iters (:base-iters opts')))))

       :base-clusters-proj
             (plmb/fnk [base-clusters]
@@ -223,31 +218,24 @@
       ; Compute group-clusters for multiple k values
       :group-clusterings
             (plmb/fnk [conv base-clusters-weights base-clusters-proj opts']
-              (into {}
-                ; XXX - should test pmap out
-                (map
+                (plmb/map-from-keys
                   (fn [k]
-                    [k
-                      (sort-by :id
-                        (kmeans base-clusters-proj k
-                          :last-clusters
-                            ; A little pedantic here in case no clustering yet for this k
-                            (let [last-clusterings (:group-clusterings conv)]
-                              (if last-clusterings
-                                (last-clusterings k)
-                                last-clusterings))
-                          :cluster-iters (:group-iters opts')
-                          :weights base-clusters-weights))])
-                  (range 2 (inc (max-k-fn base-clusters-proj (:max-k opts')))))))
+                    (sort-by :id
+                      (kmeans base-clusters-proj k
+                        :last-clusters
+                          ; A little pedantic here in case no clustering yet for this k
+                          (let [last-clusterings (:group-clusterings conv)]
+                            (if last-clusterings
+                              (last-clusterings k)
+                              last-clusterings))
+                        :cluster-iters (:group-iters opts')
+                        :weights base-clusters-weights)))
+                  (range 2 (inc (max-k-fn base-clusters-proj (:max-k opts'))))))

       ; Compute silhouette values for the various clusterings
       :group-clusterings-silhouettes
             (plmb/fnk [group-clusterings bucket-dists]
-              (into {}
-                (map
-                  (fn [[k clsts]]
-                    [k (silhouette bucket-dists clsts)])
-                  group-clusterings)))
+              (plmb/map-vals (partial silhouette bucket-dists) group-clusterings))

       ; This smooths changes in cluster counts (K-vals) by remembering what the last K was, and only changing
       ; after (:group-k-buffer opts') many times on a new K value
@@ -277,8 +265,7 @@
                 (:smoothed-k group-k-smoother)))

       :bid-to-pid (plmb/fnk [base-clusters]
-                    (greedy
-                      (map :members (sort-by :id base-clusters))))
+                    (mapv :members (sort-by :id base-clusters)))

       ;; returns {tid {
       ;;           :agree [0 4 2 0 6 0 0 1]


Increases default and max :controller-lock-num-shards (#1724)

--- scheduler/src/cook/config.clj
+++ scheduler/src/cook/config.clj
@@ -469,13 +469,13 @@
                                  pool-selection)})))
      :kubernetes (fnk [[:config {kubernetes {}}]]
                    (let [{:keys [controller-lock-num-shards]
-                          :or {controller-lock-num-shards 32}}
+                          :or {controller-lock-num-shards 4095}}
                          kubernetes
                          _
-                         (when (not (< 0 controller-lock-num-shards 256))
+                         (when (not (< 0 controller-lock-num-shards 32778))
                            (throw
                              (ex-info
-                               "Please configure :controller-lock-num-shards to > 0 and < 256 in your config file."
+                               "Please configure :controller-lock-num-shards to > 0 and < 32778 in your config file."
                                kubernetes)))
                          lock-objects
                          (repeatedly


add large array parsing benchmark

add large array parsing benchmark


(maint) Remove unecessary Schema validation

--- src/puppetlabs/puppetdb/mq.clj
+++ src/puppetlabs/puppetdb/mq.clj
@@ -2,8 +2,7 @@
   (:require
    [clojure.java.jmx :as jmx]
    [metrics.timers :refer [timer]]
-   [puppetlabs.puppetdb.metrics.core :as metrics]
-   [puppetlabs.puppetdb.schema :refer [defn-validated]]))
+   [puppetlabs.puppetdb.metrics.core :as metrics]))

 (def mq-metrics-registry (get-in metrics/metrics-registries [:mq :registry]))

@@ -11,7 +10,7 @@
                                                      (metrics/keyword->metric-name
                                                        [:global] :message-persistence-time))}))

-(defn-validated queue-size
+(defn queue-size
   "Returns the number of pending messages in the queue.
   Throws {:kind ::queue-not-found} when the queue doesn't exist."
   []


Updated graphify function that should now work with standard clojure destructuring forms.

--- src/grafter/rdf.clj
+++ src/grafter/rdf.clj
@@ -92,13 +92,13 @@
   "Takes a vector in fn binding form (where destructuring is
 supported) followed by a series of graph or triplify forms and
 concatenates them all together."
-  (let [row-sym (gensym "row")
-        row-bindings (conj row-bindings :as row-sym)]
-    `(fn graphify-rows-fn [rs#]
-       (mapcat (fn graphify-row [~row-bindings]
+  `(fn graphify-rows-fn [rs#]
+     (mapcat (fn graphify-row [row-sym#]
+               (let [~@row-bindings row-sym#]
                  (->> (concat
                        ~@forms)
-                      (map (fn [triple#] (with-meta triple# {:row ~row-sym}))))) rs#))))
+                      (map (fn [triple#] (with-meta triple# {:row row-sym#}))))))
+             rs#)))

 (defn load-triples [my-repo triple-seq]
   (doseq [triple triple-seq]


Moved away from java

Moved away from java

--- src/iroh/common.clj
+++ src/iroh/common.clj
@@ -1,12 +1,10 @@
 (ns iroh.common
-  (:require [hara.namespace.import :as im]
-            [hara.common])
-  (:import im.chit.iroh.Util))
+  (:require [hara.namespace.import :as ns]
+            [hara.common]))

 (def ^:dynamic *cache* (atom {}))

-(im/import
-  hara.common [suppress hash-map? regex?])
+(ns/import hara.common [suppress hash-map? regex?])

 (defn class-array
   "constructs a typed java array the same length as `seq`


Fix queue

Fix queue

--- src/reagent/impl/batching.cljs
+++ src/reagent/impl/batching.cljs
@@ -47,7 +47,7 @@
 (defn enqueue [queue fs f]
   (assert-some f "Enqueued function")
   (.push fs f)
-  (.schedule queue ))
+  (.schedule queue))

 (deftype RenderQueue [^:mutable ^boolean scheduled?]
   Object
@@ -75,15 +75,25 @@
     (set! scheduled? false)
     (.flush-queues this))

+  (flush-before-flush [this]
+    (when-some [fs (.-beforeFlush this)]
+      (set! (.-beforeFlush this) nil)
+      (run-funs fs)))
+
+  (flush-render [this]
+    (when-some [fs (.-componentQueue this)]
+      (set! (.-componentQueue this) nil)
+      (run-queue fs)))
+
   (flush-after-render [this]
-    (run-funs (.-afterRender this)))
+    (when-some [fs (.-afterRender this)]
+      (set! (.-afterRender this) nil)
+      (run-funs fs)))

   (flush-queues [this]
-    (run-funs (.-beforeFlush this))
+    (.flush-before-flush this)
     (ratom-flush)
-    (when-some [cs (.-componentQueue this)]
-      (set! (.-componentQueue this) nil)
-      (run-queue cs))
+    (.flush-render this)
     (.flush-after-render this)))

 (defonce render-queue (->RenderQueue false))


Remove unused namespace.

Remove unused namespace.

--- src/oc/storage/util/import.clj
+++ src/oc/storage/util/import.clj
@@ -11,7 +11,6 @@
   (:require [clojure.string :as s]
             [clojure.tools.cli :refer (parse-opts)]
             [clojure.walk :refer (keywordize-keys)]
-            [zprint.core :as zp]
             [oc.lib.db.pool :as db]
             [oc.lib.db.common :as db-common]
             [oc.storage.resources.org :as org]


Define ExceptionInfo handler for nippy #564

--- src/onyx/compression/nippy.clj
+++ src/onyx/compression/nippy.clj
@@ -1,5 +1,7 @@
 (ns onyx.compression.nippy
-  (:require [taoensso.nippy :as nippy]))
+  (:require [taoensso.nippy :as nippy]
+            [schema.utils :as su])
+  (:import [schema.utils ValidationError NamedError]))

 (nippy/extend-freeze
  clojure.lang.ExceptionInfo :schema/validation-error
@@ -24,8 +26,9 @@
   (nippy/thaw x messaging-decompress-opts))

 (def zookeeper-compress-opts {})
-
+(def aaa (atom []))
 (defn zookeeper-compress [x]
+  (swap! aaa conj x)
   (nippy/freeze x zookeeper-compress-opts))

 (def zookeeper-decompress-opts {:v1-compatibility? false})
@@ -50,3 +53,15 @@

 (defn localdb-decompress [x]
   (nippy/thaw x local-db-decompress-opts))
+
+(nippy/extend-freeze clojure.lang.ExceptionInfo :onyx/exception-info
+                     [x data-output]
+                     (.writeUTF data-output (str {:ex (.getData x)
+                                                  :str (.getMessage x)
+                                                  :cause (.getCause x)})))
+
+(nippy/extend-thaw :onyx/exception-info
+                   [data-input]
+                   (let [{:keys [ex str cause]} (read-string (.readUTF data-input))]
+                     (when cause (println cause))
+                     (clojure.lang.ExceptionInfo. str ex cause)))


Use built-in sorting function

Use built-in sorting function

--- src/play_clj/core_graphics.clj
+++ src/play_clj/core_graphics.clj
@@ -1,25 +1,4 @@
 (in-ns 'play-clj.core)
-
-; utilities
-
-(defmacro usage
-  "Returns a static field in [VertexAttributes.Usage](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/graphics/VertexAttributes.Usage.html)"
-  [k]
-  `~(u/gdx-field :graphics "VertexAttributes$Usage" (u/key->pascal k)))
-
-(defn low->high
-  "Sorts the `entities` by `k` in ascending order
-
-    (low->high :y entities)"
-  [k entities]
-  (sort #(if (< (get %1 k) (get %2 k)) -1 1) entities))
-
-(defn high->low
-  "Sorts the `entities` by `k` in descending order
-
-    (high->low :y entities)"
-  [k entities]
-  (sort #(if (< (get %1 k) (get %2 k)) 1 -1) entities))

 ; tiled maps

@@ -441,7 +420,7 @@
     (.begin batch)
     (doseq [entity (->> (map #(get-in screen [:layers %]) layer-names)
                         (apply concat entities)
-                        (high->low :y))]
+                        (sort-by :y #(compare %2 %1)))]
       (if-let [layer (:layer entity)]
         (.renderTileLayer renderer layer)
         (draw-entity! batch entity)))
@@ -564,3 +543,10 @@
   (let [^Camera camera (u/get-obj screen :camera)]
     (set! (. camera far) n)
     (.update camera)))
+
+; misc
+
+(defmacro usage
+  "Returns a static field in [VertexAttributes.Usage](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/graphics/VertexAttributes.Usage.html)"
+  [k]
+  `~(u/gdx-field :graphics "VertexAttributes$Usage" (u/key->pascal k)))


edeposit/edeposit#454 doplnil jsem unittest pro kontrolu vyrabeni zip balicku. Prosel v pohode.

--- test/edeposit/amqp/kramerius/handlers_test.clj
+++ test/edeposit/amqp/kramerius/handlers_test.clj
@@ -293,67 +293,36 @@
     )
   )

-
-(comment
-    (def payload (slurp "resources/export-request.json"))
-    (def tmpdir (fs/temp-dir "test-export-to-kramerius-request-"))
-
-    (h/save-request  [[nil payload] tmpdir])
-
-    (let [ metadata (read-string (slurp "resources/marcxml2mods-response-metadata.clj"))
-          payload (slurp "resources/marcxml2mods-response-payload.json")
-          actual-metadata (-> metadata (assoc :headers
-                                              (-> metadata :headers (assoc "UUID" (.toString tmpdir)))))
-          [mods tmpdir-0] (h/parse-mods-files (h/save-marcxml2mods-response [actual-metadata payload]))
-          [oai_dcs tmpdir-1] (h/mods->oai_dcs [mods tmpdir-0])
-          [fname result-tmpdir] (h/make-foxml [mods tmpdir-0] [oai_dcs tmpdir-1] [full-file preview-file tmpdir-2] "/var/fedora/import/")
-          uuid (slurp (io/file result-tmpdir "uuid"))
-          ]
-
-      (is (= result-tmpdir  tmpdir))
-      (is (.exists (io/file result-tmpdir uuid)))
-      (is (.isDirectory (io/file result-tmpdir uuid)))
-      (is (.isDirectory (io/file result-tmpdir uuid "xml")))
-
-
-      )
-    (fs/delete-dir tmpdir)
-    )
-
-
-
-(comment
 (deftest zip-package-test
   (testing "make zip package"
-    (def payload (slurp "resources/export-request.json"))
-    (def tmpdir (fs/temp-dir "test-export-to-kramerius-request-"))
-
-    (h/save-request  [[nil payload] tmpdir])
-
-    (let [ metadata (read-string (slurp "resources/marcxml2mods-response-metadata.clj"))
-          payload (slurp "resources/marcxml2mods-response-payload.json")
-          actual-metadata (-> metadata (assoc :headers
-                                              (-> metadata :headers (assoc "UUID" (.toString tmpdir)))))
-          [mods tmpdir-0] (h/parse-mods-files (h/save-marcxml2mods-response [actual-metadata payload]))
-          [oai_dcs tmpdir-1] (h/mods->oai_dcs [mods tmpdir-0])
-          [full-file preview-file tmpdir-2] (h/save-img-files [mods tmpdir-0])
-          [out-file result-tmpdir] (->
-                                 (h/make-foxml [mods tmpdir-0]
-                                               [oai_dcs tmpdir-1]
-                                               [full-file preview-file tmpdir-2]
-                                               "/var/fedora/import/")
-                                 h/make-zip-package
-                                 )
-          uuid (slurp (io/file result-tmpdir "uuid"))
-          ]
-
-      (is (= (.toString result-tmpdir) (.toString tmpdir)))
-      (is (.exists out-file))
-      (let [result (->  (shell/sh "zip" "-T" (.toString out-file)) :out)]
-        (is (= (re-find #" OK$" result) " OK"))
+    (let  [payload (slurp "resources/export-request.json")
+           tmpdir (fs/temp-dir "test-export-to-kramerius-request-")]
+      (h/save-request [[:no-metadata payload] tmpdir])
+      (h/prepare-marcxml2mods-request tmpdir)
+      (let [ metadata (-> (slurp "resources/marcxml2mods-response-metadata.clj")
+                          read-string
+                          (update-in [:headers] assoc "UUID" (.toString tmpdir)))
+            payload (slurp "resources/marcxml2mods-response-payload.json")
+            [mods mods-tmpdir] (-> [metadata payload]
+                                    h/save-marcxml2mods-response
+                                    h/parse-mods-files
+                                    h/add-urnnbn-to-mods)
+            [oai_dcs oai-tmpdir] (-> [mods mods-tmpdir] h/mods->oai_dcs)
+            [out-file zip-tmpdir] (-> (h/make-foxml
+                                   [mods mods-tmpdir]
+                                   [oai_dcs oai-tmpdir]
+                                   tmpdir
+                                   :fedora-import-dir "/var/fedora/import/"
+                                   :storage-dir "/var/edeposit_storage/archive"
+                                   )
+                                  h/make-zip-package
+                                  )
+            ]
+        (is (.exists out-file))
+        (let [result (->  (shell/sh "zip" "-T" (.toString out-file)) :out)]
+          (is (= (re-find #" OK$" result) " OK")))
         )
-      )
-    (fs/delete-dir tmpdir)
-    )
-  )
-)
+      (fs/delete-dir tmpdir)
+      )
+    )
+  )


Компонент вывода списка файлов

Компонент вывода списка файлов


stylistic changes

stylistic changes

--- src/signal_numbers/numbers.clj
+++ src/signal_numbers/numbers.clj
@@ -12,13 +12,15 @@
   (condp > number
    20  (base-values->words number)
    100 (let [units (mod number 10)
-                        tens (- number units)]
-                    (str (base-values->words tens)
-                         (if (not= 0 units) (str "-" (base-values->words units)))))
+             tens (- number units)]
+         (str (base-values->words tens)
+              (if (not= 0 units)
+                (str "-" (base-values->words units)))))
    1000 (let [tens-with-units (mod number 100)
-              hundreds  (-> number (- tens-with-units) (/ 100))]
+              hundreds  (quot number 100)]
           (str (base-values->words hundreds)
                " hundred"
-               (if (not= 0 tens-with-units) (str " " (int->english-words tens-with-units)))))
+               (if (not= 0 tens-with-units)
+                 (str " " (int->english-words tens-with-units)))))
    1001 "one thousand"
    nil))


Fixed report-id/reportId typo in reports.scheduler.

--- reports/src/reports/scheduler.clj
+++ reports/src/reports/scheduler.clj
@@ -16,8 +16,7 @@
       (alter cache conj {{:id reportId
                           :surveyId surveyId
                           :baseURL baseURL} path}))
-    (qs/delete-job (j/key report-id))))
-
+    (qs/delete-job (j/key reportId))))

 (defn- get-executing-jobs []
   "Returns a list of executing jobs in form of JobExecutionContext"


add clock icon

add clock icon


Unwanted function

Unwanted function

--- src-frontend/cljs/cljs_webrepl/core.cljs
+++ src-frontend/cljs/cljs_webrepl/core.cljs
@@ -183,28 +183,8 @@
       (eval-str! expression)
       (swap! state assoc :input "" :cursor 0))))

-#_(defn input-key-down [state event]
-    (case (.-which event)
-      ;; Enter
-      13 (do (eval-input state)
-             (. event preventDefault))
       (swap! state assoc :ready? false :input "" :cursor 0))))

-      ;; Escape
-      27 (do (swap! state clear-input)
-             (. event preventDefault))
-
-      ;; Tab
-      9  (. event preventDefault)
-
-      ;; Up
-      38 (do (swap! state history-prev)
-             (. event preventDefault))
-
-      ;;Down
-      40 (do (swap! state history-next)
-             (. event preventDefault))
-      nil))

 (defn input-on-change [state event]
   (assoc state


Titanium version bump.

Titanium version bump.

--- components/titan/project.clj
+++ components/titan/project.clj
@@ -3,7 +3,7 @@
             :modules {:parent "../.."}
             :description "A titan component"
             :dependencies [[gorillalabs.tesla/core :version]
-                           [gorillalabs/titanium "1.0.5"]
+                           [gorillalabs/titanium "1.0.6"]
                            [gorillalabs/titan-cassandra "1.1.1"]
                            [gorillalabs/titan-lucene "1.1.1"]
                            [org.xerial.snappy/snappy-java "1.1.2.4"] ;; keep this version


store: kill unnecessary memory store

store: kill unnecessary memory store

--- src/io/cyanite/store.clj
+++ src/io/cyanite/store.clj
@@ -7,16 +7,6 @@
 (defprotocol MetricStore
   (insert! [this metric])
   (fetch!  [this from to paths]))
-
-(defrecord MemoryStore [db]
-  component/Lifecycle
-  (start [this]
-    (assoc this :db (atom nil)))
-  (stop [this]
-    (dissoc this :db))
-  MetricStore
-  (insert! [this metric]
-    (swap! db update (:path metric) conj metric)))

 (defrecord CassandraV2Store [options session insertq fetchq
                              wrcty rdcty mkid mkpoint]
@@ -57,10 +47,6 @@

 (defmulti build-store (comp (fnil keyword "cassandra-v2") :type))

-(defmethod build-store :memory
-  [options]
-  (MemoryStore. nil))
-
 (defmethod build-store :cassandra-v2
   [options]
   (map->CassandraV2Store {:options (dissoc options :type)}))


Throw nicely worded exception if Isla code refers to a type that doesn't exist.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -34,12 +34,10 @@
         identifier (interpret (first content) env)
         type-identifier (interpret (nth content 2) env)
         type-hash (get (:types (:ctx env)) type-identifier)]
-    (let [new-ctx (assoc (:ctx env)
-                    identifier
-                    (clojure.lang.Reflector/invokeConstructor
-                     (:type type-hash) ;; the actual defrecord
-                     (to-array (:defaults type-hash))))] ;; default params vector
-      (nreturn new-ctx))))
+    (if (nil? type-hash)
+      (throw (Exception. (str "I do not know what a " type-identifier " is.")))
+      (let [new-ctx (assoc (:ctx env) identifier (instantiate-type type-hash))]
+        (nreturn new-ctx)))))

 (defmethod interpret :assignment [node env]
   (def content (:content node))


fix typo

fix typo

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1121,9 +1121,9 @@
           :synsem {:cat :verb
                    :sem {:pred :run}}}

-   "say" {:synsem {:cat :verb
-                    :past "said"
-                    :sem {:pred :say}}}
+   "say" {:english {:past "said"}
+          :synsem {:cat :verb
+                   :sem {:pred :say}}}

    "scold" {:synsem {:cat :verb
                 :sem {:pred :scold}}}


_medium_ is now a function, not hash, so call it

--- src/babel/francais/writer.clj
+++ src/babel/francais/writer.clj
@@ -74,7 +74,7 @@
                                                                 (process [{:fill-one-language
                                                                            {:count 1
                                                                             :spec spec
-                                                                            :model medium
+                                                                            :model (medium)
                                                                             }}]
                                                                          "fr")
                                                                 ;; TODO: move this to *before*


refactor (tutti) into (generate-from-spec) and (generate-one-verb)

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -19,10 +19,74 @@
 (defn rewrite-lexicon []
   (write-lexicon "it" lexicon))

-(defn tutti [ & [count]]
+(defn generate-from-spec [spec & [count]]
+  (log/debug (str "generate-from-spec: " spec))
+  (let [count (if count (Integer. count) 10)]
+    (.size (pmap (fn [tense]
+                   (let [spec (unify spec
+                                     tense)]
+                     (.size
+                      (pmap (fn [gender]
+                              (let [spec (unify spec
+                                                {:comp {:synsem {:agr gender}}})]
+                                (log/trace (str "generating from gender: " gender))
+                                (.size
+                                 (map (fn [person]
+                                        (let [spec (unify spec
+                                                          {:comp {:synsem {:agr {:person person}}}})]
+                                          (log/trace (str "generating from person: " person))
+                                          (.size
+                                           (map (fn [number]
+                                                  (let [spec (unify spec
+                                                                    {:comp {:synsem {:agr {:number number}}}})]
+                                                    (log/debug (str "generating from spec: " spec))
+                                                    (try
+                                                      (process [{:fill-one-language
+                                                                 {:count 1
+                                                                  :spec spec
+                                                                  :model small
+                                                                  }}]
+                                                               "it")
+                                                      (catch Exception e
+                                                        (cond
+
+                                                          ;; TODO: make this conditional on
+                                                          ;; there being a legitimate reason for the exception -
+                                                          ;; e.g. the verb is "funzionare" (which takes a non-human
+                                                          ;; subject), but we're trying to generate with
+                                                          ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
+                                                          ;; are human.
+                                                          true
+
+                                                          (log/warn (str "ignoring exception: " e))
+                                                          false
+                                                          (throw e))))
+                                                    ))
+                                                [:sing :plur]))))
+                                      [:1st :2nd :3rd]))))
+                            [{:gender :masc}
+                             {:gender :fem}]))))
+                 (list {:synsem {:sem {:tense :conditional}}}
+                       {:synsem {:sem {:tense :future}}}
+                       {:synsem {:sem {:tense :present}}}
+                       {:synsem {:sem {:aspect :progressive
+                                       :tense :past}}}
+                       {:synsem {:sem {:aspect :perfect
+                                       :tense :past}}}
+                       )))))
+
+(defn generate-one-verb [root-form & [count]]
+  (log/info (str "generating examples with root-form:" root-form))
+  (generate-from-spec
+   {:root {:italiano {:italiano root-form}}}
+   count))
+
+(defn tutti [ & [count lexeme]]
   (let [count (if count (Integer. count) 10)
         ;; subset of the lexicon: only verbs which are infinitives and that can be roots:
         ;; (i.e. those that have a specific (non- :top) value for [:synsem :sem :pred])
+        lexemes (if lexeme (list (get lexicon lexeme))
+                    (vals lexicon))
         root-verbs
         (zipmap
          (keys lexicon)
@@ -33,7 +97,7 @@
                            (= (get-in lexeme [:synsem :infl]) :top)
                            (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
                         lexeme-set))
-              (vals lexicon)))
+              lexemes))

         tutti
         (reduce concat
@@ -48,57 +112,6 @@
     (.size (pmap (fn [verb]
                    (log/trace (str "verb: " (strip-refs verb)))
                    (let [root-form (get-in verb [:italiano :italiano])]
-                     (log/info (str "generating with verb: '" root-form "'"))
-                     (.size (pmap (fn [tense]
-                                   (let [spec (unify {:root {:italiano {:italiano root-form}}}
-                                                     tense)]
-                                     (.size
-                                      (pmap (fn [gender]
-                                             (let [spec (unify spec
-                                                               {:comp {:synsem {:agr gender}}})]
-                                               (log/trace (str "generating from gender: " gender))
-                                               (.size
-                                                (map (fn [person]
-                                                       (let [spec (unify spec
-                                                                         {:comp {:synsem {:agr {:person person}}}})]
-                                                         (log/trace (str "generating from person: " person))
-                                                         (.size
-                                                          (map (fn [number]
-                                                                 (let [spec (unify spec
-                                                                                {:comp {:synsem {:agr {:number number}}}})]
-                                                                   (log/debug (str "generating from spec: " spec))
-                                                                   (try
-                                                                     (process [{:fill-one-language
-                                                                                {:count 1
-                                                                                :spec spec
-                                                                                :model small
-                                                                                }}]
-                                                                              "it")
-                                                                     (catch Exception e
-                                                                       (cond
-
-                                                                        ;; TODO: make this conditional on
-                                                                        ;; there being a legitimate reason for the exception -
-                                                                        ;; e.g. the verb is "funzionare" (which takes a non-human
-                                                                        ;; subject), but we're trying to generate with
-                                                                        ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
-                                                                        ;; are human.
-                                                                        true
-
-                                                                        (log/warn (str "ignoring exception: " e))
-                                                                        false
-                                                                       (throw e))))
-                                                                   ))
-                                                               [:sing :plur]))))
-                                                     [:1st :2nd :3rd]))))
-                                           [{:gender :masc}
-                                            {:gender :fem}]))))
-                                 (list {:synsem {:sem {:tense :conditional}}}
-                                       {:synsem {:sem {:tense :future}}}
-                                       {:synsem {:sem {:tense :present}}}
-                                       {:synsem {:sem {:aspect :progressive
-                                                       :tense :past}}}
-                                       {:synsem {:sem {:aspect :perfect
-                                                       :tense :past}}}
-                                       )))))
+                     (generate-one-verb root-form count)))
                  tutti))))
+