some tests

some tests

--- examples/ex22_raymarching.clj
+++ examples/ex22_raymarching.clj
@@ -19,7 +19,7 @@

 (def canvas (create-canvas w h))

-(def windows (show-window canvas "raymarching" w h 15))
+(def window (show-window canvas "raymarching" w h 15))

 (defmethod key-pressed ["raymarching" \space] [_]
   (save-canvas canvas "results/ex22/scene.jpg"))
@@ -35,7 +35,6 @@
 (def ^Vec3 glow-color (v/div (Vec3. 255 153 51) 255.0))

 (def ^Vec3 sun-lin (Vec3. 1.2 0.5 1.8)) ;; material color
-

 (do
   (def ^Vec3 ro (Vec3. 0.0 5.0 10.0)) ;; ray origin
@@ -81,13 +80,13 @@
           h (max 0.0 (f (.x p) (.z p)))
           newres (min res (/ (* k h) t))]
       (if (or (< h 0.0001)
-              (> i 50))
+              (> i 20))
         (m/constrain newres 0.0 1.0)
         (recur (unchecked-inc i) newres (+ t (m/constrain h 0.02 0.5)))))))

-(def terrain-f (comp (var/make-variation :sinusoidal 1.0 {})
-                     (var/make-variation :auger 1.0 {})))
+(def terrain-f (comp (var/make-variation :sinusoidal 1.2 {})
+                     (var/make-variation :auger 0.7 {})))

 (defn terrain
   ""
@@ -98,7 +97,7 @@
 (defn normal
   ""
   [f ^Vec3 v t]
-  (let [eps (max 0.02 (* 0.001 t))]
+  (let [eps (max 0.002 (* 0.0001 t))]
     (v/normalize (Vec3. (- (f (- (.x v) eps) (.z v))
                            (f (+ (.x v) eps) (.z v)))
                         (+ eps eps)
@@ -159,14 +158,12 @@
             col (if (< t maxt) ;; terrain
                         (let [^Vec3 pos (v/add ro (v/mult rd t))
                               ^Vec3 nor (normal terrain pos t)
-                              ref (reflect rd nor)
                               hh (- 1.0 (smoothstep -2.0 1.0 (.y pos)))
                               sun (m/constrain (v/dot nor sun-light) 0.0 1.0)
                               sha (if (> sun 0.01) (softshadow pos sun-light terrain) 0.0)
                               sky (+ 0.5 (* 0.5 (.y nor)))

-                              lin (v/emult (v/mult sun-lin sun) (Vec3. sha (m/pow sha 1.2) (m/pow sha 1.5)))
-                              ]
+                              lin (v/emult (v/mult sun-lin sun) (Vec3. sha (m/pow sha 1.2) (m/pow sha 1.5)))]
                           (calc-fog t lin bcol))
                         bcol)
             col (v/add col (v/mult glow-color (* (* 0.2 s s) (m/constrain (/ (+ (.y rd) 0.4) 0.4) 0.0 1.0)))) ;; sun glow


Code review: Always prefer :require over :use

See https://groups.google.com/d/msg/clojure-dev/kbcI3bkJr_0/FIf0o9inN4MJ

:refer :all is still a bit naughty (can make it hard for people who
use your code to find out where functions came from). meh.


versino 1.8.0 of clojure adn 0.4.0 of camel-snake-kebab

--- serpent-talk/project.clj
+++ serpent-talk/project.clj
@@ -1,8 +1,8 @@
-(defproject serpent-talk "0.1.0-SNAPSHOT"
+(defproject serpent-talk "1.0.0"
   :description "FIXME: write description"
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.7.0"]
-                 [camel-snake-kebab "0.3.2"]])
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [camel-snake-kebab "0.4.0"]])


Write simply

Write simply

--- src/cljam/io/wig.clj
+++ src/cljam/io/wig.clj
@@ -119,7 +119,7 @@
                     (throw (IllegalArgumentException. "Invalid wiggle format")))]
             (recur (rest lines)
                    wigs
-                   (update current-track :values #(conj % v)))))))))
+                   (update current-track :values conj v))))))))

 (defn- serialize-wig
   "Serialize WIG line into vector of strings."


Fix svg ->xy typo.

Fix svg ->xy typo.

--- src/cljx/c2/svg.cljx
+++ src/cljx/c2/svg.cljx
@@ -17,7 +17,7 @@
   "Convert coordinates (potentially map of `{:x :y}`) to 2-vector."
   [coordinates]
   (cond
-   (and (vector? coordinates) (= 2 (count count))) coordinates
+   (and (vector? coordinates) (= 2 (count coordinates))) coordinates
    (map? coordinates) [(:x coordinates) (:y coordinates)]))

 (defn translate [coordinates]


Added support to iso19115 format.

Added support to iso19115 format.

--- src/cmr/umm/core.clj
+++ src/cmr/umm/core.clj
@@ -32,6 +32,10 @@
   [concept]
   (iso-mends-c/parse-collection (:metadata concept)))

+(defmethod parse-concept [:collection "application/iso19115+xml"]
+  [concept]
+  (iso-mends-c/parse-collection (:metadata concept)))
+
 (defmethod parse-concept [:collection "application/iso-mends+xml"]
   [concept]
   (iso-mends-c/parse-collection (:metadata concept)))
@@ -61,6 +65,10 @@
   [umm format]
   (iso-mends/umm->iso-mends-xml umm))

+(defmethod umm->xml :iso19115
+  [umm format]
+  (iso-mends/umm->iso-mends-xml umm))
+
 (defmethod umm->xml :iso-mends
   [umm format]
   (iso-mends/umm->iso-mends-xml umm))


update csv.clj

update csv.clj

--- src/codestat/csv.clj
+++ src/codestat/csv.clj
@@ -217,13 +217,13 @@
     file))

-(defn write-workspae-increment-dlr-to-csv
+(defn write-workspace-increment-dlr-to-csv
   [workspace file]
   (write-workspace-dlr-to-csv workspace file get-increment-lines))

 ;;; project's everyday progress
-(defrecord project-lines-record
+(defrecord project-date-lines-record
     [project date lines])

 (defn get-project-and-date
@@ -234,7 +234,7 @@
   [workspace functor]
   (let [dm (group-by get-project-and-date
             (filter is-valid-record? (get-workspace-records workspace)))]
-    (map #(->project-lines-record
+    (map #(->project-date-lines-record
            (:project %1)
            (:date %1)
            (functor (get dm %1)))
@@ -264,3 +264,17 @@
 ;;; count total line of project
 ;;;

+
+
+(defn get-date-lines-records-of-project
+  [records project ]
+  "cumulate added-lines deleted-lines"
+  (let [rs-1 (filter #(= project (:project %1))
+                   records)
+        rs-2 (group-by #(get-date %) rs-1)]
+    (map #(->date-lines-record
+           %1
+           (get-increment-lines (get rs-2 %1)))
+         (keys rs-2))))
+
+


om jobs whitespace fixes

om jobs whitespace fixes

--- frontend/components/jobs.cljs
+++ frontend/components/jobs.cljs
@@ -33,7 +33,7 @@
           [:h2 "Why you'll love working at CircleCI"]
           [:p
            [:strong "Our culture is customer-driven."]
-           "Our customers and our founders are engineers, and most of our employees are too. We are inspired by companies like "
+           " Our customers and our founders are engineers, and most of our employees are too. We are inspired by companies like "
            [:a {:href "http://blog.alexmaccaw.com/stripes-culture"} "Stripe,"]
            " "
            [:a {:href "http://gigaom.com/2012/03/26/tales-from-the-trenches-github/"} "GitHub,"]
@@ -66,7 +66,7 @@
           [:p
            [:strong "Local"]
            [:span " — "]
-           "Our team is dedicated to creating the most productive environment possible. That means we ensure everyone is able to enjoy their own personal level of comfort and privacy.We work in San Francisco's beautiful Financial District, where you'll have a "
+           "Our team is dedicated to creating the most productive environment possible. That means we ensure everyone is able to enjoy their own personal level of comfort and privacy. We work in San Francisco's beautiful Financial District, where you'll have a "
            [:a
             {:href "http://blog.circleci.com/silence-is-for-the-weak"}
             "private office"]
@@ -94,7 +94,7 @@
              [:a
               {:href "http://blog.circleci.com/kindness-is-underrated"}
               "Pleasant people"]
-             " , and good conversationalists - we'll be spending the next few years together after all."]
+             ", and good conversationalists - we'll be spending the next few years together after all."]
             [:li
              "Folks with an interest in the whole company, not just their job. Our transparent culture allows everyone to take a holistic view of the company. As a result, we really like people who enjoy getting familiar with the whole business, customers, product, culture, selling, etc."]]]

@@ -225,11 +225,11 @@

          [:div.jobs-how
           [:h2#apply "How to apply"]
-          [:p "Send an email to " [:a {:href "mailto:jobs@circleci.com"} "jobs@circleci.com"] " including a resume."]
-          [:p
-           "We're mostly interested in seeing evidence that you're great at what you do. (Don't worry if you're not convinced about your abilities, just work to convince us.) This might include great projects you've worked on, a portfolio, wonderful references, open source you've contributed to, products you've built or scaled, your grades at MIT, that you got hired by Google, or anything that hints that you might be a particularly amazing individual.We're also interested in reading about technologies you've worked with in the past, and what you did with them."]
-          [:p
-           "The kind of people we want to work with tend to pitch us as to why they should work at CircleCI.This is both why you're interested, and why you think you'd be a good part of the team. If all goes well we're going to spend a lot of time together, so it's worth it for both of us to discuss this in advance."]
+          [:p "Send an email to " [:a {:href "mailto:jobs@circleci.com"} "jobs@circleci.com"] ", including a resume."]
+          [:p
+           "We're mostly interested in seeing evidence that you're great at what you do. (Don't worry if you're not convinced about your abilities, just work to convince us.) This might include great projects you've worked on, a portfolio, wonderful references, open source you've contributed to, products you've built or scaled, your grades at MIT, that you got hired by Google, or anything that hints that you might be a particularly amazing individual. We're also interested in reading about technologies you've worked with in the past, and what you did with them."]
+          [:p
+           "The kind of people we want to work with tend to pitch us as to why they should work at CircleCI. This is both why you're interested, and why you think you'd be a good part of the team. If all goes well we're going to spend a lot of time together, so it's worth it for both of us to discuss this in advance."]
           [:p
            "Naturally, this goes both ways. We're happy to answer any questions you have about CircleCI, where we're going, why it's an amazing place to work, and what we're doing to keep it that way."]
           [:p


rewrite previous design listing, less flowery

--- frontend/components/jobs.cljs
+++ frontend/components/jobs.cljs
@@ -134,45 +134,25 @@
            [:h3 [:span "Design roles"]]
            [:p
             "Our customers love great experiences, and so do we. We're looking for amazing designers who can provide them."]
-           [:h5 "We're looking for"]
-           [:ul
-            [:li
-             "An inspiring ability to create graceful solutions when confronted by complex design challenges."]
-            [:li
-             "An obsessive devotion to user-experience problem solving and a sharp understanding of its inherit imperfections."]
-            [:li
-             "An exceedingly confident resolve, built from an exceedingly diverse repertoire of skillsets."]
-            [:li
-             "An intimate love affair with learning and an equally essential appetite for ground-breakingly new ideas."]
-            [:li
-             "An exceptional talent for communicating efficiently in a developer-centric, fast-paced environment."]
-            [:li
-             "An understanding of how to engage with developers, both inside and outside the context of a team."]
-            [:li "Taste."]]
-           [:h5 "We'd love to see"]
-           [:ul
-            [:li "Any cool stuff you may have on dribbble, Behance, etc."]
-            [:li
-             "What kind of high-level or back-end programming knowledge you may have."]
-            [:li
-             "How you manage and traverse large, complex technology stacks."]
-            [:li
-             "You send — along with your coverletter — an image of a puppy, in formal wear, doing yoga."]
-            [:li
-             "If you've ever built or helped build any type of developer-oriented tools in the past."]]
-           [:h5 "With the ability to"]
-           [:ul
-            [:li "Write beautiful HTML and CSS."]
-            [:li
-             "Navigate JS/Coffee comfortably and fix things when they break."]
-            [:li
-             "Build your own mockups, prototypes, and production-ready concepts."]
-            [:li
-             "Ship, believing done is better than perfect and iteration is better than perfection."]
-            [:li
-             "Uphold and improve upon existing brand standards and guidelines."]
-            [:li
-             "Most importantly, relate to our customers; primarily developers."]]
+           [:h5 "You will be responsible for"]
+           [:ul
+             [:li "Actively engaging with product strategy and development."]
+             [:li "Collaborating between various teams with diverse skill sets."]
+             [:li "Embracing an environment with increasingly tight feedback loops."]
+             [:li "Prototyping, producing, and shipping your own designs."]
+             [:li "Acting as a self-starter and motivating yourself to meet your own deadlines."]
+             [:li "Upholding and improving upon existing brand standards and guidelines."]]
+           [:h5 "We would love to see"]
+           [:ul
+             [:li "An ability to create simple solutions for complex challenges."]
+             [:li "Someone who considers the user's experience from start to finish."]
+             [:li "An aptitude in many skill sets and a hunger for learning."]
+             [:li "The ability to communicate effeciently in a developer-centric environment."]
+             [:li "A strong personality with a equally strong sense of taste."]
+             [:li "A deep understanding of web design and development best practices."]
+             [:li "Work you've done for other web-based developer tools."]
+             [:li "Any other interesting work you wish to share, finished or not."]
+             [:li "A willingness to approach sophisticated problems with an incredibly talented team at your side."]]
            [:a
             {:role "button", :href "/jobs#apply"}
             [:span "Apply for Design roles"]]]


Use get instead of symbol as function

Use get instead of symbol as function

--- src/control/core.clj
+++ src/control/core.clj
@@ -237,7 +237,7 @@
         new-body (postwalk (fn [item]
                              (if (list? item)
                                (let [cmd (first item)]
-                                 (if (cmd system-functions)
+                                 (if (and (symbol? cmd) (get system-functions cmd))
                                    (list* cmd  '&host '&user 'cluster (rest item))
                                    item))
                                item))


Avoid creating a new ssh connection every-request, cache SSH agent, session and channels

--- src/dakait/files.clj
+++ src/dakait/files.clj
@@ -6,15 +6,39 @@
     [clojure.java.io :as io]
     [clj-ssh.ssh :as ssh]))

-(def ^{:dynamic true} *ssh-agent* (ssh/ssh-agent {}))
+(def ssh-agent (atom nil))
+(def ssh-session (atom nil))
+(def ssh-channel (atom nil))
+
 (defn- agent-with-identity []
-  (when (ssh/has-identity? *ssh-agent* "sftp-server")
-    *ssh-agent*)
-  (ssh/add-identity *ssh-agent*
-                { :name "sftp-server"
+  (when
+    (or (nil? @ssh-agent)
+        (not (ssh/ssh-agent? @ssh-agent)))
+    (let [agent (ssh/ssh-agent {})]
+      (ssh/add-identity agent { :name "sftp-server"
                   :public-key-path (config :public-key)
                   :private-key-path (config :private-key) })
-  (identity *ssh-agent*))
+      (info "new agent")
+      (reset! ssh-agent agent)))
+  @ssh-agent)
+
+(defn- session []
+  (when (nil? @ssh-session)
+    (let [session (ssh/session (agent-with-identity) (config :sftp-host) {:strict-host-key-checking :no})]
+      (reset! ssh-session session)))
+  (when-not (ssh/connected? @ssh-session)
+    (info "Reconnecting session...")
+    (ssh/connect @ssh-session))
+  @ssh-session)
+
+(defn- channel []
+  (when (nil? @ssh-channel)
+    (let [channel (ssh/ssh-sftp (session))]
+      (reset! ssh-channel channel)))
+  (when-not (ssh/connected-channel? @ssh-channel)
+    (info "Reconnecting channel")
+    (ssh/connect-channel @ssh-channel))
+  @ssh-channel)

 (defn join-path [& parts]
   (.getPath (apply io/file parts)))
@@ -29,12 +53,11 @@
                           :size (file-size e)}))))))

 (defn list-remote-files [path]
-  (let [session (ssh/session (agent-with-identity) (config :sftp-host) {:strict-host-key-checking :no})]
-    (ssh/with-connection session
-      (let [channel (ssh/ssh-sftp session)]
-        (ssh/with-channel-connection channel
-          (when (not (nil? path)) (ssh/sftp channel {} :cd path))
-          (ssh/sftp channel {} :ls))))))
+  ;;(let [this-channel (ssh/ssh-sftp (session))]
+    ;;(ssh/with-channel-connection this-channel
+  (let [this-channel (channel)]
+      (when (not (nil? path)) (ssh/sftp this-channel {} :cd path))
+      (ssh/sftp this-channel {} :ls)))

 (defn all-remote-files [path]
   (let [query-path (join-path (config :base-path) path)


(PE-4982) Remove unused config file

(PE-4982) Remove unused config file

--- configs/puppetserver/puppet-server.clj
+++ configs/puppetserver/puppet-server.clj
@@ -1,18 +0,0 @@
-(defproject puppetlabs.packages/puppetserver "{{{puppet-server-version}}}"
-  :description "Release artifacts for puppet-server"
-  :pedantic? :abort
-  :dependencies [[puppetlabs/puppet-server "{{{puppet-server-version}}}"]
-                 [puppetlabs/trapperkeeper-webserver-jetty9 "0.5.2"]]
-
-  :uberjar-name "puppet-server-release.jar"
-
-  :repositories [["releases" "http://nexus.delivery.puppetlabs.net/content/repositories/releases/"]
-                 ["snapshots" "http://nexus.delivery.puppetlabs.net/content/repositories/snapshots/"]]
-  :main puppetlabs.trapperkeeper.main
-
-  :ezbake { :user "puppet"
-            :group "puppet"
-            :build-type "foss"
-            :java-args "-Xmx1g"
-            }
-  )


Update data_readers.clj

Update data_readers.clj

--- src/data_readers.clj
+++ src/data_readers.clj
@@ -1,3 +1,3 @@
 {
-  ?= clominal.debug/print
+  ?= tames.debug/print
  }


Don’t use http kit client yet

Don’t use http kit client yet

--- src/gateway/core.clj
+++ src/gateway/core.clj
@@ -2,7 +2,7 @@
   (:gen-class)
   (:use org.httpkit.server
         [clojure.tools.logging :as log]
-        [org.httpkit.client :as http]
+        ; [org.httpkit.client :as http] ; TODO: later make proper async calls to handlers
         [clojure.core.async
              :as a
              :refer [>! <! >!! <!! go chan buffer close! thread


remove unused file

remove unused file

--- resources/leiningen/new/tenzing/foo.clj
+++ resources/leiningen/new/tenzing/foo.clj
@@ -1 +0,0 @@
-(def {{name}} :foo)


Update the build object more often, so the email code has the correct status when it runs

--- src/circle/backend/build/run.clj
+++ src/circle/backend/build/run.clj
@@ -38,8 +38,10 @@
     (when (-> @build :continue?)
       (let [current-act-results-count (count (-> @build :action-results))]
         (build/build-log "running %s" (-> act :name))
-        (action/run-action build act))))
+        (action/run-action build act)
+        (build/update-mongo build))))
   (stop* build)
+  (build/update-mongo build)
   build)

 (defn log-result [b]


Comment out debugging code.

Comment out debugging code.

--- src/circleci/web/views/index.clj
+++ src/circleci/web/views/index.clj
@@ -108,7 +108,7 @@
   "") ; return a string

 (defpartial youre-done [& content]
-  (delete-cookie :signed-up)
+;  (delete-cookie :signed-up) ; For debugging
   [:div.move-right
    [:h2.blue-box "Thanks!" [:br] "We'll be in touch soon!"]])


Add an onblur handler to put the instructions back in.

--- src/circleci/web/views/index.clj
+++ src/circleci/web/views/index.clj
@@ -32,7 +32,9 @@
         (unordered-list
          [(list (text-field {:id "email"
                              :type "text"
-                             :onfocus "if (this.value == 'Email address') { this.value=''};"} "email" "Email address"))
+                             :onfocus "if (this.value == 'Email address') { this.value=''};"
+                             :onblur "if (this.value == '') { this.value = 'Email address'};"}
+                             "email" "Email address"))
           (list (check-box {:id "contact"
                              :name "contact"
                              :checked true} "contact")


formatting

formatting

--- src/clj/com/rpl/specter/impl.clj
+++ src/clj/com/rpl/specter/impl.clj
@@ -131,10 +131,10 @@
         (if (= t :svalspath)
           (fn [curr next]
             (fn [vals structure next-fn]
-                    (curr vals structure
-                          (fn [vals-next structure-next]
-                            (next vals-next structure-next next-fn)
-                            ))))
+              (curr vals structure
+                    (fn [vals-next structure-next]
+                      (next vals-next structure-next next-fn)
+                      ))))
           (fn [curr next]
             (fn [structure next-fn]
               (curr structure (fn [structure] (next structure next-fn)))))


Revert "feature: Add delete-datastore-raw to datastore features (#62)"

This reverts commit 59159bede1e2b97ff87b5df687551e4f3da185f8.

--- src/clj/datasplash/datastore.clj
+++ src/clj/datasplash/datastore.clj
@@ -28,15 +28,6 @@
                    (cond-> query (.withQuery query))
                    (cond-> namespace (.withNamespace namespace))
                    (cond-> num-query-split (.withNumQuerySplits num-query-split)))]
-    (apply-transform pcoll ptrans named-schema opts)))
-
-(defn delete-datastore-raw
-  "delete a pcoll of already generated datastore entity from datastore"
-  [{:keys [project-id] :as options} pcoll]
-  (let [opts (assoc options :label :delete-datastore-raw)
-        ptrans (-> (DatastoreIO/v1)
-                   (.deleteEntity)
-                   (.withProjectId project-id))]
     (apply-transform pcoll ptrans named-schema opts)))

 (declare value->clj)


Fixes Paige Piper message and makes the trash event unpreventable.

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -426,25 +426,26 @@
     :leave-play (req (remove-watch state :order-of-sol))}

    "Paige Piper"
-   (let [pphelper (fn [card cards]
+   (let [pphelper (fn [title cards]
                     (let [num (count cards)]
                       {:optional
-                       {:prompt (str "Use Paige Piper to trash copies of " (:title card) "?")
+                       {:prompt (str "Use Paige Piper to trash copies of " title "?")
                         :yes-ability {:prompt "How many would you like to trash?"
                                       :choices {:number (req num)}
                                       :msg "shuffle their Stack"
                                       :effect (req (doseq [c (take (int target) cards)]
-                                                               (trash state side c))
+                                                     (trash state side c {:unpreventable true}))
                                                    (shuffle! state :runner :deck)
                                                    (when (> (int target) 0)
                                                      (system-msg state side (str "trashes " (int target)
                                                                                " cop" (if (> (int target) 1) "ies" "y")
-                                                                                " of " (:title card)))))}}}))]
+                                                                                " of " title))))}}}))]
      {:events {:runner-install {:req (req (first-event state side :runner-install))
                                 :effect (effect (resolve-ability
-                                                 (pphelper target (->> (:deck runner)
-                                                                       (filter #(has? % :title (:title target)))
-                                                                       (vec)))
+                                                 (pphelper (:title target)
+                                                           (->> (:deck runner)
+                                                                (filter #(has? % :title (:title target)))
+                                                                (vec)))
                                                  card nil))}}})

    "Paparazzi"


using '/' property path notation in sparql

--- src/clj/webapp/models/sparql.clj
+++ src/clj/webapp/models/sparql.clj
@@ -119,7 +119,7 @@
 ))

 (defn pdgmqry-sparql-fv-note [language lpref valstring]
-  "This version, for the moment only called by the single pdgm display option, which is designed to give the most information about an individual paradigm, includes information about input paradigm notes and lex. Note info should eventually be displayed in the paradigm-label listing."
+  "This version, for the moment only called by the single pdgm display option, which is designed to give the most information about an individual paradigm, includes information about input paradigm notes, lex, and token-... . Note info should eventually be displayed in the paradigm-label listing."
     (let [;; if assume last value is lex (generalize to other pos?)
           vals (clojure.string/replace valstring #"(.*):.*?$" "$1")
           ;;lex (clojure.string/replace valstring #".*:(.*?)$" "$1")
@@ -144,8 +144,7 @@
           {
 	   ?s {{lpref}}:pos {{lpref}}:Verb .
 	   ?s aamas:lang aama:{{Language}} .
-	   ?s aamas:lang ?lang .
-	   ?lang rdfs:label ?langLabel .
+	   ?s aamas:lang / rdfs:label ?langLabel .
            ?s aamas:lexeme ?lexeme .
            ?lexeme rdfs:label ?lex . ")
        {:lpref lpref
@@ -160,16 +159,13 @@
                  :lpref lpref})))
       (tmpl/render-string
        (str "
-	   OPTIONAL { ?s {{lpref}}:number ?number .
-	   ?number rdfs:label ?num . }
+	   OPTIONAL { ?s {{lpref}}:number / rdfs:label ?num . }
 	   OPTIONAL { ?s {{lpref}}:pngShapeClass ?pngSC .
-           ?pngSC rdfs:label  ?shapeClass}
+             ?pngSC rdfs:label  ?shapeClass .}
 	   ?s {{lpref}}:person ?person .
 	   ?person rdfs:label ?pers .
-	   OPTIONAL { ?s {{lpref}}:gender ?gender .
-	   ?gender rdfs:label ?gen . }
-	   OPTIONAL { ?s aamas:memberOf ?termcluster .
-	   ?termcluster rdfs:comment ?comment . }
+	   OPTIONAL { ?s {{lpref}}:gender / rdfs:label ?gen . }
+	   OPTIONAL { ?s aamas:memberOf / rdfs:comment ?comment . }
 	   ?s {{lpref}}:token ?tkn .
            BIND ((IF(BOUND(?pngSC),
                      CONCAT(?tkn,\"[\",SUBSTR(?shapeClass,4,1),\"]\"),


break down the chunk process into multiple transducers

--- src/clj_money/import/gnucash.clj
+++ src/clj_money/import/gnucash.clj
@@ -276,6 +276,7 @@
       result)))

 (defn- process-output
+  "Writes the records to the next output file and resets the record buffer"
   [{:keys [verbose
            records
            output-folder
@@ -349,20 +350,34 @@
           (xf result record)
           result))))))

-(defn- advance-context
-  [{:keys [records max-record-count] :as context}]
-  (if (>= (count records) max-record-count)
-    (process-output context)
-    context))
-
-(defn- process-chunk-record
-  "Processes a single record for the file chunking process"
-  ([result] result)
-  ([{:keys [progress-chan] :as context} record]
-   (>!! progress-chan [:record record])
-   (-> context
-       (update-in [:records] #(conj % record))
-       advance-context)))
+(defn- evaluate-output
+  "Evaluates the output for the chunking process
+  and writes the file and resets the record buffer if the
+  maximum number of records has been reached"
+  ([context _] (evaluate-output context))
+  ([{:keys [records max-record-count] :as context}]
+   (if (>= (count records) max-record-count)
+     (process-output context)
+     context)))
+
+(defn- append-record
+  [xf]
+  (fn
+    ([] (xf))
+    ([context] (xf context))
+    ([context record]
+     (xf
+       (update-in context [:records] #(conj % record))
+       record))))
+
+(defn- notify-record
+  [progress-chan xf]
+  (fn
+    ([] (xf))
+    ([context] (xf context))
+    ([context record]
+     (>!! progress-chan [:record record])
+     (xf context record))))

 (defn chunk-file
   "Accepts a path to a gnucash file and creates multiple, smaller files
@@ -377,8 +392,10 @@
                  (with-open [input-stream (FileInputStream. input-file)]
                    (->> (read-source :gnucash input-stream)
                         (transduce
-                          filter-record
-                          process-chunk-record
+                          (comp filter-record
+                                append-record
+                                (partial notify-record progress-chan))
+                          evaluate-output
                           {:output-paths []
                            :verbose (-> opts :options :verbose)
                            :records []


Comments and transducer

Comments and transducer

--- src/cljs/clojure_rest/utils.cljs
+++ src/cljs/clojure_rest/utils.cljs
@@ -5,12 +5,12 @@

 (defn lower-str-contains
-  "Check whether the first string contains the second string"
+  "Check whether the first string contains the second string, not taking the case into account"
   [stack needle]
   (str/includes? (str/lower-case stack) (str/lower-case needle)))

 (defn remove-idx
-  "Remove the given index from the vector - but in linear time!"
+  "Remove the given index from the vector - in linear time (could be made logarithmic)"
   [v idx]
   (vec
     (concat (subvec v 0 idx) (subvec v (inc idx) (count v)))
@@ -20,8 +20,8 @@
   "Like map but over the values of an associative container"
   [f coll]
   (into {}
-    (map (fn [[k v]] [k (f v)]) coll)
-  ))
+    (map (fn [[k v]] [k (f v)]))
+    coll))

 (defn set-transfer-data
   "Set the transfer data inside a drag start event"


Refresh movement implemented.

Refresh movement implemented.

--- src/cljs/movement/generator.cljs
+++ src/cljs/movement/generator.cljs
@@ -35,6 +35,27 @@
       (session/update-in! [:movement-session :parts position-in-parts :movements]
                           conj (first (shuffle @movements))))))

+(defn refresh-movement [m part-title]
+  (go
+    (let [movements (atom [])
+          parts (session/get-in [:movement-session :parts])
+          position-in-parts (first (positions #{part-title} (map :title parts)))
+
+          movement-list (vec (session/get-in [:movement-session :parts position-in-parts :movements]))
+
+          ;todo: get categories from the movement, not the part.
+          categories (:categories (first (filter #(= part-title (:title %)) parts)))
+          categories-prepped (mapv #(str/replace % " " "-") categories)]
+
+      (doseq [c categories-prepped]
+        (swap! movements conj (first (read-string (<! (GET (str "singlemovement/" c)))))))
+
+      (let [position-in-movement-list (first (positions #{m} movement-list))
+            movement-list (assoc movement-list position-in-movement-list (first (shuffle @movements)))]
+
+        (session/assoc-in! [:movement-session :parts position-in-parts :movements]
+                            movement-list)))))
+
 (defn remove-movement [m part-title]
   (go
     (let [parts (session/get-in [:movement-session :parts])
@@ -53,7 +74,7 @@
         [:div.pure-u.movement

          [:div.pure-g
-          [:div.pure-u-1-2.refresh {:on-click #()}]
+          [:div.pure-u-1-2.refresh {:on-click #(refresh-movement m part-title)}]
           [:div.pure-u-1-2.destroy {:on-click #(remove-movement m part-title)}]]

          [:div.pure-g.title
@@ -90,11 +111,11 @@
     (fn [{:keys [title categories movements]}]
       [:div
        [:h2 title]
+       [:button {:type     "submit"
+                 :on-click #(get-new-movement title)} "+"]
        [:div.pure-g
         (for [m movements]
-          ^{:key (str m (rand-int 10000))} [movement-component m title])]
-       [:button {:type     "submit"
-                 :on-click #(get-new-movement title)} "+"]])))
+          ^{:key (str m (rand-int 100000))} [movement-component m title])]])))

 (defn session-component []


Allow the use of the DATABASE_URL env variable.

--- src/clojure/staircase/config.clj
+++ src/clojure/staircase/config.clj
@@ -29,7 +29,9 @@
   (k @configuration))

 (defn db-options [opts]
-  (options opts "db-"))
+  (if-let [uri (:database-url opts)]
+    {:connection-uri uri}
+    (options opts "db-")))

 (defn app-options [opts]
   (options opts "web-"))


add user details to navbar

add user details to navbar

--- src-cljs/imago/core.cljs
+++ src-cljs/imago/core.cljs
@@ -51,12 +51,14 @@
               (build-nav nav-routes sel-id user)]
              [:ul.nav.navbar-nav.navbar-right
               (if (:user @state)
-                [:li [:a {:href "#"
-                          :events [[:click
-                                    (fn [e]
-                                      (.preventDefault e)
-                                      (login/handle-logout (:bus @state)))]]}
-                      "Logout"]]
+                (list
+                 [:li [:a "Logged in as " (-> @state :user :user-name)]]
+                 [:li [:a {:href "#"
+                           :events [[:click
+                                     (fn [e]
+                                       (.preventDefault e)
+                                       (login/handle-logout (:bus @state)))]]}
+                       "Logout"]])
                 [:li [:a {:href "#"
                           :events [[:click
                                     (fn [e]


Fixed up logic for OPeNDAP coordinates (don't do too much).

--- src/cmr/opendap/ous/variable.clj
+++ src/cmr/opendap/ous/variable.clj
@@ -224,17 +224,15 @@

 (defn create-opendap-bounds
   ([bounding-box]
-    (if bounding-box
-      (create-opendap-bounds
-        {:x default-x-hi :y default-y-hi}
-        bounding-box)
-      nil))
-  ([{x-dim :x y-dim :y} [lon-lo lat-lo lon-hi lat-hi]]
-   (let [x-lo (lon-lo-phase-shift x-dim lon-lo)
-         x-hi (lon-hi-phase-shift x-dim lon-hi)
-         y-lo (lat-lo-phase-shift y-dim lat-lo)
-         y-hi (lat-hi-phase-shift y-dim lat-hi)]
-     (create-opendap-lookup x-lo y-lo x-hi y-hi))))
+   (create-opendap-bounds {:x default-x-hi :y default-y-hi} bounding-box))
+  ([{x-dim :x y-dim :y} [lon-lo lat-lo lon-hi lat-hi :as bounding-box]]
+   (if bounding-box
+     (let [x-lo (lon-lo-phase-shift x-dim lon-lo)
+           x-hi (lon-hi-phase-shift x-dim lon-hi)
+           y-lo (lat-lo-phase-shift y-dim lat-lo)
+           y-hi (lat-hi-phase-shift y-dim lat-hi)]
+       (create-opendap-lookup x-lo y-lo x-hi y-hi))
+     nil)))

 (defn format-opendap-lat
   ([opendap-bounds]
@@ -290,12 +288,13 @@
   spatial subsetting"
   [entry bounding-box]
   (let [dims (extract-dimensions entry)
-        bounds (or bounding-box (extract-bounds entry))]
+        ; bounds (or bounding-box (extract-bounds entry))
+        ]
     {:concept-id (get-in entry [:meta :concept-id])
      :name (get-in entry [:umm :Name])
      :dimensions dims
-     :bounds bounds
-     :opendap (create-opendap-bounds dims bounds)
+     :bounds bounding-box
+     :opendap (create-opendap-bounds dims bounding-box)
      :size (get-in entry [:umm :Characteristics :Size])}))


Clean logs

Clean logs

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -643,17 +643,13 @@
   Map-reader will defer the read when the key is not present at entity."
   [{:keys [ast query] :as env}]
   (let [entity (entity env)]
-    (if (= :token-complex (:key ast))
-      (clojure.pprint/pprint ["Map read" query]))
     (if-let [[_ v] (find entity (:key ast))]
       (if (sequential? v)
         (if query
           (join-seq env v)
           v)
         (if (and (map? v) query)
-          (do
-            (println "VAI" (keys v))
-            (join v env))
+          (join v env)
           v))
       ::continue)))


Normalized env includes placeholder configuration by default

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -1048,12 +1048,13 @@
      ([env tx target]
       (parser
         (merge
-          {::entity            (atom {})
-           ::request-cache     (atom {})
-           ::entity-key        ::entity
-           ::entity-path-cache (atom {})
-           ::parent-query      tx
-           ::root-query        tx}
+          {::entity               (atom {})
+           ::request-cache        (atom {})
+           ::entity-key           ::entity
+           ::entity-path-cache    (atom {})
+           ::placeholder-prefixes #{">"}
+           ::parent-query         tx
+           ::root-query           tx}
           env
           {::plugin-actions (group-plugins-by-action plugins)
            ::plugins        plugins


CMR-4558 Cleanup

CMR-4558 Cleanup

--- search-app/src/cmr/search/site/data.clj
+++ search-app/src/cmr/search/site/data.clj
@@ -70,6 +70,8 @@
         (sort-by #(get-in % [:umm :EntryTitle]) data)))

 (defn-timed get-collection-data
+  "Get the collection data from elastic by provider id and tag. Sort results
+  by entry title"
   [context tag provider-id]
   (let [conditions (query-svc/generate-query-conditions-for-parameters
                     context
@@ -81,11 +83,15 @@
                                   :skip-acls? false
                                   :page-size :unlimited
                                   :result-format :query-specified
-                                  :result-fields [:concept-id :doi-stored :entry-title :short-name :version-id]})
+                                  :result-fields [:concept-id
+                                                  :doi-stored
+                                                  :entry-title
+                                                  :short-name
+                                                  :version-id]})
         result (query-exec/execute-query context query)]
     (sort-by :entry-title (:items result))))

-(defmethod collection-data :default
+(defn-timed collection-data :default
   [context tag provider-id]
   (get-collection-data context tag provider-id))


loaded oto golem

loaded oto golem

--- src/maqueta/core.clj
+++ src/maqueta/core.clj
@@ -2,20 +2,26 @@
   (:use (maqueta application assets))
   (:import com.jme3.math.ColorRGBA
            com.jme3.math.Vector3f
-           com.jme3.scene.Geometry
-           com.jme3.scene.shape.Box)
+           com.jme3.scene.Node
+           com.jme3.light.DirectionalLight)
   (:gen-class))

-(def player (let [box (Box. Vector3f/ZERO 1 1 1)
-                  geo (Geometry. "blue cube" box)
-                  mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")]
-              (.setColor mat "Color" ColorRGBA/Blue)
-              (.setMaterial geo mat)
-              geo))
+(def light (DirectionalLight.))
+
+(def player (load-model "Models/Oto/Oto.mesh.xml"))
+
+(defn setup-fn
+  [app]
+  (let [root-node (.getRootNode app)
+        viewport (.getViewPort app)]
+    (.setBackgroundColor viewport ColorRGBA/LightGray)
+    (.setDirection light (.normalizeLocal (Vector3f. -0.1 -1 -1)))
+    (.addLight root-node light)
+    (.setLocalScale player (Vector3f. 0.5 0.5 0.5))))

 (defn -main [& args]
   (.start (make-app player
-                    no-op
+                    setup-fn
                     no-op
                     {:key-h (fn [n p t] (.rotate player 0 1 0))}
                     {:key-j (fn [n v t] (.rotate player 0 v 0))})))


Fix #16: non-markdown folders are now ignored

--- src/markiki/core.clj
+++ src/markiki/core.clj
@@ -96,7 +96,10 @@
   "Given a source path it will explore the folder tree and write a json in the out-path"
   [src-path out-path]
   (spit (str out-path "/markiki.json")
-        (generate-string (flatten (parse-tree src-path "")) {:pretty true})))
+        (generate-string (->> (parse-tree src-path "")
+                              flatten
+                              (remove nil?))
+                         {:pretty true})))

 (defn generate-index


Invoke update-mainfest! properly

Invoke update-mainfest! properly

don't you wish you could rewrite history sometimes

--- src/mdr2/dtb/xml.clj
+++ src/mdr2/dtb/xml.clj
@@ -92,7 +92,7 @@
   the meta data from `production`. If a `manifest` is given the
   `volume` is ignored"
   ([production volume]
-   (update-mainfest! volume (path/manifest-path production volume)))
+   (update-mainfest! production volume (path/manifest-path production volume)))
   ([production _ manifest]
    (let [updated (with-open [r (io/reader manifest)]
                   (update-meta-data (xml/parse r :support-dtd false)


re-organising comments

re-organising comments

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -1,4 +1,3 @@
-; You shouldn't be able to move your marble once you've entered :marble-moved
 (ns nonaga.draw
   (:use [nonaga.react :only [circle svg create-class render-component]])
   (:require [nonaga.core :as n]
@@ -79,6 +78,7 @@
 (defn start-marble-move [component color coord]
   (update-state component #(assoc % :event [:marble-selected color coord])))

+; You shouldn't be able to move your marble once you've entered :marble-moved
 (defn draw-marbles [component state color]
   (let [cp     (get-in state [:event 1])
         coords (color state)
@@ -90,7 +90,7 @@
   (js/console.log (str (.-wrapper (.-state js/board))))
   false)

-; This shit is the same as start-marble-move
+; This is the same as start-marble-move
 (defn ring-selected [component color coord]
   (update-state component #(assoc % :event [:ring-selected color coord])))


split drawing of rings from coords

split drawing of rings from coords

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -46,12 +46,29 @@
 (def svg-node
   (sel1 :svg))

-(doall
-  (for [[ix iy] rings]
-    (let [x (+ 20 (* 40 ix) (if (odd? iy) 20 0))
-          y (+ 20 (* 40 iy))]
-      (dommy/append! svg-node (ring x y))
-      (dommy/append! svg-node (make-text (- x 10) (+ y 5) (str ix "," iy))))))
+(defn hex-coord->svg-coord [[hex-x hex-y]]
+  (let [x (+ 20 (* 40 hex-x) (if (odd? hex-y) 20 0))
+        y (+ 20 (* 40 hex-y))]
+    [x y]))

+(defn coord->str [[x y]]
+  (str x "," y))

+; Could make these functional by removing svg-node and append!
+(defn draw-rings [svg-node coords]
+  (->> coords
+       (map hex-coord->svg-coord)
+       (mapv (fn [[x y]] (dommy/append! svg-node (ring x y))))))

+(defn draw-coords [svg-node coords]
+  (letfn [(draw [coord [x y]]
+            (let [text (make-text (- x 10) (+ y 5) (coord->str coord))]
+              (dommy/append! svg-node text)))]
+    (->> coords
+         (map hex-coord->svg-coord)
+         (mapv draw coords))))
+
+(draw-rings svg-node rings)
+
+; (draw-coords svg-node rings)
+


Validate tenancy-id does not include /.

Validate tenancy-id does not include /.

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -504,8 +504,13 @@
 (s/defschema JobId
   (s/cond-pre s/Uuid s/Keyword))

+(s/defschema TenancyIdStr
+  (s/pred (fn [s]
+            (and (string? s)
+                 (nil? (re-find #"/" s))))))
+
 (s/defschema TenancyId
-  (s/cond-pre s/Uuid s/Str))
+  (s/cond-pre s/Uuid TenancyIdStr))

 (s/defschema TaskId
   (s/cond-pre s/Uuid s/Keyword))


Use .isBound in safe-var-get instead of catching exception

--- src/de/kotka/vimclojure/util.clj
+++ src/de/kotka/vimclojure/util.clj
@@ -236,9 +236,8 @@

 (defn safe-var-get
   [the-var]
-  (try
-    (var-get the-var)
-    (catch IllegalStateException _ nil)))
+  (when (.isBound the-var)
+    (var-get the-var)))

 (defn- type-of-completion
   [thing]


Fixed bug in clj->vim of Named things

Fixed bug in clj->vim of Named things

--- src/de/kotka/vimclojure/util.clj
+++ src/de/kotka/vimclojure/util.clj
@@ -226,7 +226,9 @@

 (defmethod clj->vim clojure.lang.Named
   [thing]
-  (str-wrap (name thing) \"))
+  (if-let [prefix (namespace thing)]
+    (str-wrap (str prefix "/" (name thing)) \")
+    (str-wrap (name thing) \")))

 (defmethod clj->vim Number
   [thing]


Handle negative instants smoothly.

Handle negative instants smoothly.

As soon as you go before the metronome origin, you are at the end of
the preceding beat, so using floor() rather than truncating towards
zero is the right way to calculate the marker number.


Cleanup code

Cleanup code

--- src/reitit/core.cljc
+++ src/reitit/core.cljc
@@ -38,18 +38,14 @@
   ([routes]
    (walk ["" []] routes))
   ([[pacc macc] routes]
-   (let [subwalk (fn [path meta routes]
-                   (reduce
-                     (fn [acc route]
-                       (into acc (walk [path meta] route)))
-                     []
-                     routes))]
+   (letfn [(subwalk [p m r]
+             (reduce #(into %1 (walk [p m] %2)) [] r))]
      (if (vector? (first routes))
        (subwalk pacc macc routes)
        (let [[path & [maybe-meta :as args]] routes]
-         (let [[meta childs] (if-not (vector? maybe-meta)
-                               [maybe-meta (rest args)]
-                               [{} args])
+         (let [[meta childs] (if (vector? maybe-meta)
+                               [{} args]
+                               [maybe-meta (rest args)])
                macc (into macc (expand meta))]
            (if (seq childs)
              (subwalk (str pacc path) macc childs)
@@ -58,16 +54,13 @@
 (defn map-meta [f routes]
   (mapv #(update % 1 f) routes))

-(defn merge-meta
-  ([x]
-   (merge-meta (constantly :into) x))
-  ([key-strategy x]
-   (reduce
-     (fn [acc [k v]]
-       (let [strategy (or (key-strategy k) :replace)]
-         (deep-merge strategy acc {k v})))
-     {}
-     x)))
+(defn merge-meta [key-strategy x]
+  (reduce
+    (fn [acc [k v]]
+      (let [strategy (or (key-strategy k) :replace)]
+        (deep-merge strategy acc {k v})))
+    {}
+    x))

 (defn resolve-routes
   ([x]


should be sufficient to only do sem-impl on [:cat :noun]

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -377,7 +377,12 @@
         lexical-entry))

 (defn semantic-implicature [lexical-entry]
-  {:synsem {:sem (sem-impl (get-in lexical-entry [:synsem :sem]))}})
+  (if (= (get-in lexical-entry [:synsem :cat]) :noun)
+    ;; this rule is only necessary with nouns: other parts of speech can select nouns based on their
+    ;; semantics derived via the nouns' use of this rule.
+    {:synsem {:sem (sem-impl (get-in lexical-entry [:synsem :sem]))}}
+
+    lexical-entry))

 (defn put-a-bird-on-it [lexical-entry]
   "example lexical entry transformer."
@@ -538,6 +543,7 @@
             (if (fail? result)
               (do
                 (log/error (str "lexical entry cannot be added: " (strip-refs result) ";fail-path: " (fail-path result)))
+                ;; TODO: throw exception here
                 :fail)
               (if (isomorphic? result lexical-entry)
                 ;; done: one final step is to add serialization to the entry.


+(defn noun-pred-defaults)

+(defn noun-pred-defaults)

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -701,6 +701,18 @@
                                    (get lexicon k))])
                 (keys lexicon))))

+(defn noun-pred-defaults [lexicon]
+  (into {} (map (fn [k] [k (map (fn [v]
+                                  (if (= :noun (get-in v [:synsem :cat]))
+                                    (let [unif (unify v {:synsem {:cat :noun
+                                                                  :sem (sem-impl (dag_unify.core/strip-refs (get-in v [:synsem :sem])))}})]
+                                      (if (not (= :fail unif))
+                                        unif
+                                        v))
+                                    v))
+                                (get lexicon k))])
+                (keys lexicon))))
+
 (defn verb-pred-defaults [lexicon verb-pred-default-list]
   (if (not (empty? verb-pred-default-list))
     (verb-pred-defaults (default lexicon (first verb-pred-default-list))


Fix api calls for alia.

Fix api calls for alia.

--- src/kixi/hecuba/api/datasets.clj
+++ src/kixi/hecuba/api/datasets.clj
@@ -2,6 +2,7 @@
   (:require
    [bidi.bidi :as bidi]
    [clojure.string :as string]
+   [clojure.tools.logging :as log]
    [kixi.hecuba.protocols :as hecuba]
    [kixi.hecuba.queue :as q]
    [kixi.hecuba.security :as sec]
@@ -45,10 +46,12 @@
   (get-in ctx [:request :route-params :entity-id]))

 (defn- name-from [ctx]
-  (get-in ctx [:request :route-params :namee]))
+  (get-in ctx [:request :route-params :name]))

 (defn index-post! [commander ctx]
-  (let [request                (:request ctx)
+   (log/info "index-post!")
+
+   (let [request                (:request ctx)
         {:keys [members name]} (decode-body request)
         entity-id              (entity-id-from ctx)
         members-str            (string/join \, members)
@@ -63,11 +66,12 @@
     (hash-map :name name
               :entity-id entity-id)))

-(defn index-handle-ok [querier req]
-  (let [route-params (:route-params req)]
-    (util/render-items req (hecuba/items querier
+(defn index-handle-ok [querier ctx]
+  (let [entity-id   (entity-id-from ctx)]
+    (log/info "index-handle-ok")
+    (util/render-items ctx (hecuba/items querier
                              :dataset
-                             (select-keys route-params [:entity-id])))))
+                              [[= :entity-id entity-id]]))))

 (defn index-handle-created [handlers ctx]
   (let [entity-id   (entity-id-from ctx)
@@ -76,6 +80,7 @@
                                (:dataset @handlers)
                                :entity-id entity-id
                                :name name)]
+    (log/info "index-handle-created!")
     (when-not location
       (throw (ex-info "No path resolved for Location header"
                       {:entity-id entity-id
@@ -86,15 +91,18 @@
   :allowed-methods       #{:get :post}
   :available-media-types #{"application/edn" "text/html"}
   :authorized?           (authorized? querier :datasets)
-  :post!                 (partial index-post! querier)
+  :post!                 (partial index-post! commander)
   :handle-ok             (partial index-handle-ok querier)
   :handle-created        (partial index-handle-created handlers))

-(defn resource-exists? [querier req]
-  (let [{route-params :route-params} req
+(defn resource-exists? [querier ctx]
+  (let [request      (:request ctx)
+        route-params (:route-params request)
         {:keys [entity-id name]} route-params]
-    (when-let [item (first (hecuba/items querier :dataset {:entity-id entity-id
-                                                           :name name}))]
+    (log/infof "resource-exists? :%s:%s" entity-id name)
+
+    (when-let [item (first (hecuba/items querier :dataset [[= :entity-id entity-id]
+                                                           [= :name name]]))]
         {::item item}
         #_(throw (ex-info (format "Cannot find item of id %s"))))))

@@ -104,11 +112,14 @@
         ds {:entity_id (entity-id-from ctx)
             :name      (name-from ctx)
             :members   (string/join \, members)}]
+    (log/infof "resource-post! %s" ds)
+
     (hecuba/upsert! commander :dataset ds)))

-(defn resource-handle-ok [req]
-  (let [item (::item req)]
-    (util/render-item req item)))
+(defn resource-handle-ok [ctx]
+  (let [item (::item ctx)]
+    (log/info "resource-handle-ok")
+    (util/render-item ctx item)))

 (defresource resource [{:keys [commander querier]} handlers]
   :allowed-methods       #{:get :post}


Update browser repl script.

Update browser repl script.

--- src/leiningen/new/mies/brepl.clj
+++ src/leiningen/new/mies/brepl.clj
@@ -9,5 +9,5 @@
    :output-dir "out"
    :verbose true})

-(repl/repl* (browser/repl-env)
-  {:output-dir "out"})
+(repl/repl (browser/repl-env)
+  :output-dir "out")


Fix a warning in todomvc

Fix a warning in todomvc

Add a type hint to fix `Cannot infer target type in expression (. event -token)`.

--- examples/todomvc/src/todomvc/core.cljs
+++ examples/todomvc/src/todomvc/core.cljs
@@ -36,7 +36,7 @@
 (defonce history
   (doto (History.)
     (events/listen EventType.NAVIGATE
-                   (fn [event] (secretary/dispatch! (.-token event))))
+                   (fn [^js/goog.History.Event event] (secretary/dispatch! (.-token event))))
     (.setEnabled true)))


WIP - travail sur l'exercice Grains

WIP - travail sur l'exercice Grains

--- exercism/clojure/grains/src/grains.clj
+++ exercism/clojure/grains/src/grains.clj
@@ -1,9 +1,9 @@
 (ns grains)

-(defn square [] ;; <- arglist goes here
-    ;; your code goes here
+(defn square [case-number]
+    (bigint (Math/pow 2 (dec case-number)))
 )

-(defn total []  ;; <- arglist goes here
-    ;; your code goes here
+(defn total []
+    (reduce + (map square (range 1 65)))
 )


Add a blank line

Add a blank line

Beauty is its own reward.

Signed-off-by: Daniel Borchmann <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@algebra20.de>

--- src/main/clojure/conexp/main.clj
+++ src/main/clojure/conexp/main.clj
@@ -76,4 +76,5 @@
       (reply/launch {:custom-eval '(do (in-ns 'conexp.main)
                                        (use 'clojure.repl))
                      :custom-help ""})))
+
   (System/exit 0))


Removed unused printlns.

Removed unused printlns.

--- src/cbfg/world-lane.cljs
+++ src/cbfg/world-lane.cljs
@@ -45,13 +45,11 @@
                                                               @client-hist (:replay-to v))
                                                 (let [cmd (assoc v :opaque ts)
                                                       cmd-rq ((get cmd-handlers (:op cmd)) cmd)]
-                                                  (println "in" cmd cmd-rq)
                                                   (render-client-hist (swap! client-hist
                                                                              #(assoc % ts [cmd nil])))
                                                   (aput client in-ch cmd-rq)
                                                   (recur (inc num-ins) num-outs)))
-                                (= ch out-ch) (do (println "out" v)
-                                                  (render-client-hist (swap! client-hist
+                                (= ch out-ch) (do (render-client-hist (swap! client-hist
                                                                              #(update-in % [(:opaque v) 1]
                                                                                conj [ts v])))
                                                   (recur num-ins (inc num-outs))))))


add nicknames to seed

add nicknames to seed

--- src/chat/server/seed.clj
+++ src/chat/server/seed.clj
@@ -16,10 +16,12 @@
                                      :name "Penyo Pal"})
           user-1 (db/create-user! {:id (db/uuid)
                                    :email "raf@leanpixel.com"
+                                   :nickname "rafd"
                                    :password (get env :rafal-password "foobar")
                                    :avatar "https://s3.amazonaws.com/chat.leanpixel.com/avatars/4801271456_41230ac0b881cdf85c28_72.jpg"})
           user-2 (db/create-user! {:id (db/uuid)
                                    :email "james@leanpixel.com"
+                                   :nickname "jamesnvc"
                                    :password (get env :james-password "foobar")
                                    :avatar "https://s3.amazonaws.com/chat.leanpixel.com/avatars/4805955000_07dc272f0a7f9de7719e_192.jpg"})
           _ (db/user-add-to-group! (user-1 :id) (group-1 :id))


bump up tag character limit

bump up tag character limit

--- src/chat/server/util.clj
+++ src/chat/server/util.clj
@@ -13,6 +13,6 @@
   "Checks if a tag name is valid, but not if already taken"
   [tag]
   (not (or (string/blank? tag)
-           (< 30 (count tag))
+           (< 50 (count tag))
            (re-find #"\s" tag)
            (re-find #"\p{Punct}" tag))))


explain tail of single-pred cat

explain tail of single-pred cat

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -1168,8 +1168,8 @@
 (defn- op-explain [form p path via in input]
   ;;(prn {:form form :p p :path path :input input})
   (let [[x :as input] input
+        {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve p)
         via (if-let [name (spec-name p)] (conj via name) via)
-        {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve p)
         insufficient (fn [path form]
                        {path {:reason "Insufficient input"
                               :pred (abbrev form)
@@ -1189,13 +1189,13 @@
                     (if-let [p1 (deriv p1 x)]
                       (explain-pred-list forms ps path via in (preturn p1))
                       (op-explain (op-describe p1) p1 path via in input)))
-            ::pcat (let [[pred k form] (->> (map vector
-                                                 ps
-                                                 (c/or (seq ks) (repeat nil))
-                                                 (c/or (seq forms) (repeat nil)))
-                                            (remove (fn [[p]]
-                                                      (accept-nil? p)))
-                                            first)
+            ::pcat (let [pkfs (map vector
+                                   ps
+                                   (c/or (seq ks) (repeat nil))
+                                   (c/or (seq forms) (repeat nil)))
+                         [pred k form] (if (= 1 (count pkfs))
+                                         (first pkfs)
+                                         (first (remove (fn [[p]] (accept-nil? p)) pkfs)))
                          path (if k (conj path k) path)
                          form (c/or form (op-describe pred))]
                      (if (c/and (empty? input) (not pred))
@@ -1278,11 +1278,13 @@
       (if-let [dp (deriv p x)]
         (recur dp xs (inc i))
         (if (accept? p)
-          {path {:reason "Extra input"
-                 :pred (abbrev (op-describe re))
-                 :val data
-                 :via via
-                 :in (conj in i)}}
+          (if (= (::op p) ::pcat)
+            (op-explain (op-describe p) p path via (conj in i) (seq data))
+            {path {:reason "Extra input"
+                   :pred (abbrev (op-describe re))
+                   :val data
+                   :via via
+                   :in (conj in i)}})
           (c/or (op-explain (op-describe p) p path via (conj in i) (seq data))
                 {path {:reason "Extra input"
                        :pred (abbrev (op-describe p))


Adds audio-footprint calls.

Adds audio-footprint calls.

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -609,3 +609,28 @@

   Example: (get-several-tracks {:ids \"2Dlo9QsN9ohaz9kASYkKmv,6XYvLpqJFebcjnOTolwkGw\" :market \"SE\"} \"BQBw-JtC..._7GvA\")"
   (api-get "tracks"))
+
+(def get-audio-analysis-for-a-track
+  " Takes two arguments, a map m with query parameters and an optional oauth-token t.
+  Compulsory key in m is :id.
+:id has to have the value of an existing track's id.
+
+  Example: (get-audio-analysis-for-a-track {:id \"2Dlo9QsN9ohaz9kASYkKmv\"} \"BQBw-JtC..._7GvA\")"
+  (api-get "audio-analysis/id"))
+
+(def get-audio-features-for-a-track
+  " Takes two arguments, a map m with query parameters and an optional oauth-token t.
+  Compulsory key in m is :id.
+:id has to have the value of an existing track's id.
+
+  Example: (get-audio-features-for-a-track {:id \"2Dlo9QsN9ohaz9kASYkKmv\"} \"BQBw-JtC..._7GvA\")"
+  (api-get "audio-features/id"))
+
+(def get-audio-features-for-several-tracks
+  " Takes two arguments, a map m with query parameters and an optional oauth-token t.
+  Compulsory key in m is :ids.
+:ids has to be a comma separated string of spotify track ids.
+
+  Example: (get-audio-features-for-several-tracks {:ids \"2Dlo9QsN9ohaz9kASYkKmv,6XYvLpqJFebcjnOTolwkGw\"} \"BQBw-JtC..._7GvA\")"
+  (api-get "audio-features"))
+


Ensure game is focussed when switching

Ensure game is focussed when switching

--- src/cljs/kenny/core.cljs
+++ src/cljs/kenny/core.cljs
@@ -360,6 +360,10 @@

 (defn grid [grid owner]
   (reify
+    om/IDidMount
+    (did-mount [this]
+      (.. js/document (querySelector ".grid") (focus))
+      )
     om/IRenderState
     (render-state [this state]
       (apply
@@ -498,6 +502,7 @@
                (dom/span #js {:className "life"} (str "Leben: " (get-in app [:hero :life]) "%"))
                (dom/button #js {:onClick (fn [e] (do
                                                    (om/transact! app [:hero] (fn [_] default-hero))
+                                                   (.. js/document (querySelector ".grid") (focus))
                                                    false))

                                 }


Fix bug with deregister of hide shortcut not working

--- src/cljs/klang/core.cljs
+++ src/cljs/klang/core.cljs
@@ -332,7 +332,10 @@
         (h "input" #js{:style #js{:background "#000"
                                   :color "white"
                                   :width "350px"}
+                       :id "search"
+                       :tabIndex 1
                        :onChange (fn [e] (!! assoc :search (.. e -target -value)))
+                       :autoFocus true
                        :type "text"
                        :defaultValue (:search @db "")
                        :placeholder "Search"})
@@ -409,7 +412,7 @@

 (defn install-toggle-shortcut!
-  "Installs a Keyboard Shortcut handler that show/hide the log overlay.
+  "Installs a Keyboard Shortcut handler that toggles the visibility of the log overlay.
    Call the return function to unregister."
   [shortcut]
   ;; If previous one exist just unregister it:
@@ -421,7 +424,7 @@
       handler
       KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
       (fn [e] (toggle-showing!)))
-    (js/console.info "Klang: Keyboard shortcut installed:" shortcut)
+    (js/console.info "Klang: Toggle overlay keyboard shortcut installed:" shortcut)
     (!! assoc :shortcut-toggle-keys #(.unregisterShortcut handler shortcut))))

 (defn install-hide-shortcut!
@@ -437,9 +440,8 @@
       handler
       KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
       (fn [e] (toggle-showing! false)))
-    (js/console.info "Klang: Keyboard hide shortcut installed:" shortcut)
-    (!! assoc :shortcut-keys #(.unregisterShortcut handler shortcut))))
-
+    (js/console.info "Klang: Hide overlay keyboard shortcut installed:" shortcut)
+    (!! assoc :shortcut-hide-keys #(.unregisterShortcut handler shortcut))))

 (defn set-max-logs!
   "Only keep the last n logs. If nil: No truncating."


added entry point for initializing the router

--- src/routom/core.cljs
+++ src/routom/core.cljs
@@ -1,5 +1,5 @@
 (ns routom.core
-  (:require [om.next :as om]
+  (:require [om.next :as om :refer-macros [ui defui]]
             [routom.util :as u]
             [goog.module.ModuleManager :as module-manager])
   (:import goog.module.ModuleManager))
@@ -47,3 +47,111 @@
                 new-params (merge params (om/params ui))]
             (recur (butlast p) new-params new-query))))
       )))
+
+(defui ModuleStatus
+  Object
+  (initLocalState [_]
+    {:status :loading})
+  (componentWillMount
+    [this]
+    (let [{:keys [module-id]} (om/props this)
+          manager (module-manager/getInstance)]
+      (if-let [module (.getModuleInfo manager module-id)]
+        (let [on-error (.registerErrback module (fn [_] (om/update-state! this assoc :status :error)))
+              on-load (.registerCallback module (fn [_] (om/update-state! this assoc :status :success)))]
+          (om/update-state! this assoc :on-err on-error)
+          (om/update-state! this assoc :on-load on-load)))))
+  (componentWillUnmount [this]
+    (let [{:keys [on-error on-load]} (om/get-state this)]
+      (when on-error (.abort on-error))
+      (when on-load (.abort on-load))))
+  (render [this]
+    (let [{:keys [render-status module-id]} (om/props this)
+          {:keys [status]} (om/get-state this)]
+      (when render-status (render-status status module-id)))))
+
+(defn get-element-tree
+  [route-map path root-props props render-module-status]
+  (loop [p path
+         element nil]
+    (if (empty? p)
+      element
+      (let [keys (u/path->keys p)
+            {:keys [ui module-id] :as route} (get-in route-map keys)]
+
+        (if module-id
+          (recur (butlast p)
+                 (when (some? render-module-status)
+                   ((om/factory ModuleStatus)
+                     {:module-id     module-id
+                      :render-status render-module-status})))
+          (let [fac (if ui #(om/factory ui) #(om/factory route))
+                child-element (if element
+                                ((fac) (om/computed props root-props) element)
+                                ((fac) (om/computed props root-props))
+                                )]
+            (recur (butlast p) child-element)))))))
+
+(defn- set-active-query!
+  [component route-atom hierarchy-atom route-id route-params]
+  (let [routes @route-atom
+        hierarchy @hierarchy-atom
+        path (u/get-path hierarchy route-id)
+        route (u/get-route routes path)]
+    (if (some? route)
+      (om/set-query! component (get-route-query route-atom [:root] path route-params)))))
+
+
+(defn init-router
+  ([routes]
+   (init-router routes nil))
+  ([routes render-module-status]
+
+   (let [route-hierarchy (atom (u/create-hierarchy @routes))
+         active-route (atom nil)]
+     (add-watch routes :route/hierarchy (fn [_ _ _ next-state]
+                                          (reset! route-hierarchy (u/create-hierarchy next-state))))
+     (let [set-active-route! #(reset! active-route %1)
+           AppRoot
+           (ui
+             static om/IQuery
+             (query [this] [:root])
+             Object
+             (componentWillMount
+               [this]
+
+               (letfn [(on-route-changed [{:keys [route/name route/params] :as active-route}]
+
+                         (when active-route
+                           (set-active-query! this routes route-hierarchy name params)))]
+                 (add-watch
+                   active-route
+                   :app-root
+                   (fn [_ _ _ next]
+                     (on-route-changed next)))
+                 (on-route-changed @active-route)
+                 ))
+             (componentWillUnmount
+               [this]
+               (remove-watch active-route :app-root))
+             (render [this]
+                     (let [{:keys [route/name] :as active-route} @active-route]
+                       (if active-route
+                         (let [path (u/get-path @route-hierarchy name)
+                               props (om/props this)
+                               root-props (merge
+                                            props
+                                            active-route)
+                               route-props (get props name)
+                               element-tree (get-element-tree @routes path root-props route-props render-module-status)]
+                           element-tree))
+                       )))]
+       {:AppRoot           AppRoot
+        :set-active-route! set-active-route!}))))
+
+
+
+
+
+
+


Improve docs for config.clj

Improve docs for config.clj

--- src/ruuvi/config.clj
+++ src/ruuvi/config.clj
@@ -1,19 +1,18 @@
 (ns ruuvi.config
+  "Reading configuration files"
   (:require
    [clojure.edn :as edn]
-   )
-  )
+   ))

-(defn- validate [config]
-  config
-  )
+(defn- validate
+  "Validate configuration file. Check that all references files are found, all required data is found etc."
+  [config]
+  ;; TODO implement, use Schema to validate structure...
+  config)

-(defn read-config [file]
+(defn read-config
+  "Read and validates configuration file."
+  [file]
   (with-open [r (java.io.PushbackReader.
                  (clojure.java.io/reader file))]
     (validate (doall (edn/read r)))))
-
-
-;;(read-config "dev/config.edn")
-
-


Turn on markdown rendering

Turn on markdown rendering

--- frontend/components/documentation.cljs
+++ frontend/components/documentation.cljs
@@ -141,7 +141,7 @@
         (om/build docs-title doc)
         (if-not (empty? (:children doc))
           (om/build article-list (:children doc))
-          (doc-utils/render-haml-template (:slug doc) (assoc doc :article doc)))]))))
+          (om/build markdown (:markdown doc)))]))))

 (defrender documentation [app owner opts]
   (let [subpage (get-in app [:navigation-data :subpage])


Fix post urls -- had the if-transforms reversed.

--- src/swartz/views.clj
+++ src/swartz/views.clj
@@ -23,8 +23,8 @@
   [{:keys [post]}]
   [:a.title] (content (:title post))
   [:a.title] (if-transform (:url post)
-                           (set-attr :href (str "/posts/" (:id post)))
-                           (set-attr :href (:url post))))
+                           (set-attr :href (:url post))
+                           (set-attr :href (str "/posts/" (:id post)))))

 (defsnippet post-list "templates/post-list.html"
   [:.post-list]
@@ -52,8 +52,8 @@
   [{:keys [post identity]}]
   [:a.title] (content (:title post))
   [:a.title] (if-transform (:url post)
-                           (set-attr :href (str "/posts/" (:id post)))
-                           (set-attr :href (:url post)))
+                           (set-attr :href (:url post))
+                           (set-attr :href (str "/posts/" (:id post))))
   [:.content] (content (:content post))
   [:.new-note :form.note] (set-attr :action
                                     (str "/posts/" (:id post) "/notes"))


Show an input

Show an input

--- src/tadmin/core.cljs
+++ src/tadmin/core.cljs
@@ -5,10 +5,10 @@
 (enable-console-print!)

 (def app-state
-  (atom {:couch-url "/couchdb"}))
+  (atom {:couch-url "/couchdb/"}))

 (om/root
   (fn [app owner]
-    (dom/h1 nil (:couch-url app)))
+    (dom/input #js {:type "text" :value (:couch-url app)}))
   app-state
   {:target (. js/document (getElementById "top"))})


Tweak parse-str

Tweak parse-str

--- src/transit/read.clj
+++ src/transit/read.clj
@@ -62,16 +62,15 @@
   ;;(prn "parse-str before" s)
   (let [res (if (and (string? s)
                      (> (.length ^String s) 1)
-                     (= w/ESC (subs ^String s 0 1)))
-              (let [c (subs s 1 2)]
-                (case c
-                  "~" (subs s 1)
-                  "^" (subs s 1)
-                  "`" (subs s 1)
-                  "#" s
-                  (if-let [decode-fn (decode-fn (subs s 1 2))]
-                    (decode-fn (subs s 2))
-                    s)))
+                     (= "~" (subs ^String s 0 1)))
+              (case (subs s 1 2)
+                "~" (subs s 1) ;; ESC
+                "^" (subs s 1) ;; SUB
+                "`" (subs s 1) ;; RESERVED
+                "#" s ;; TAG
+                (if-let [decode-fn (decode-fn (subs s 1 2))]
+                  (decode-fn (subs s 2))
+                  s))
               s)]
     ;;(prn "parse-str after" res)
     res))


make chat easily selectable with tab

make chat easily selectable with tab

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -74,6 +74,7 @@
                                    (cast! :chat-submitted)
                                    false)}
            [:textarea {:id "chat-box"
+                       :tab-index "1"
                        :type "text"
                        :value (or chat-body "")
                        :placeholder "Send a message..."


fix sources for mixpanel

fix sources for mixpanel

--- src-cljs/frontend/components/outer.cljs
+++ src-cljs/frontend/components/outer.cljs
@@ -83,7 +83,7 @@
                "Then we'll just ask you to make a custom subdomain for you and your team."])
             (when-not (utils/logged-in? owner)
               [:div.early-access-sign
-               (om/build common/google-login {:source "Early Access Form"})])]
+               (om/build common/google-login {:source "Team Signup Form"})])]
            [:div.early-access-form {:class (str (when disabled? "disabled ")
                                                 (when submitting? "submitting ")
                                                 (when submitted? "submitted "))}
@@ -188,7 +188,7 @@

             (when-not (utils/logged-in? owner)
               [:div.early-access-sign
-               (om/build common/google-login {:source "Early Access Form"})])]
+               (om/build common/google-login {:source "Solo Signup Form"})])]

            [:div.early-access-form {:class (str (when disabled? "disabled ")
                                                 (when submitting? "submitting ")


Fix var name

Fix var name

--- frontend/utils/ajax.cljs
+++ frontend/utils/ajax.cljs
@@ -70,7 +70,7 @@
                       {:X-CSRFToken (utils/csrf-token)})
         format-opts (case format
                       :json {:format (clj-ajax/json-request-format)
-                             :response-format (json-response-format {:keywords? keywords? :url url :method method})
+                             :response-format (json-response-format {:keywords? keywords? :url uri :method method})
                              :keywords? keywords?
                              :headers (merge {:Accept "application/json"}
                                              csrf-header


de-dupe QP process functions.

de-dupe QP process functions.

--- src/metabase/query_processor.clj
+++ src/metabase/query_processor.clj
@@ -396,37 +396,33 @@
 ;;
 ;; Post-processing then happens in order from bottom-to-top; i.e. POST-ANNOTATE gets to modify the results, then LIMIT, then CUMULATIVE-SUM, etc.

-(defn process
-  "Process a QUERY and return the results."
-  [driver query]
-  (when-not *disable-qp-logging*
-    (log/debug (u/format-color 'blue "\nQUERY: 😎\n%s"  (u/pprint-to-str query))))
-  (binding [*driver* driver]
-    (let [driver-process-in-context (partial driver/process-query-in-context driver)
-          driver-process-query      (partial (if (structured-query? query)
-                                               driver/process-structured
-                                               driver/process-native) driver)]
-      ((<<- wrap-catch-exceptions
-            pre-add-settings
-            pre-expand-macros
-            pre-expand-resolve
-            driver-process-in-context
-            post-add-row-count-and-status
-            post-format-rows
-            pre-add-implicit-fields
-            pre-add-implicit-breakout-order-by
-            cumulative-sum
-            limit
-            post-annotate
-            pre-log-query
-            wrap-guard-multiple-calls
-            driver-process-query) (assoc query :driver driver)))))
-
-
 (defn process-query
   "Process an MBQL structured or native query, and return the result."
   [query]
-  (process (driver/database-id->driver (:database query)) query))
+  (when-not *disable-qp-logging*
+    (log/debug (u/format-color 'blue "\nQUERY: 😎\n%s"  (u/pprint-to-str query))))
+  ;; TODO: it probably makes sense to throw an error or return a failure response here if we can't get a driver
+  (let [driver (driver/database-id->driver (:database query))]
+    (binding [*driver* driver]
+      (let [driver-process-in-context (partial driver/process-query-in-context driver)
+            driver-process-query      (partial (if (structured-query? query)
+                                                 driver/process-structured
+                                                 driver/process-native) driver)]
+        ((<<- wrap-catch-exceptions
+              pre-add-settings
+              pre-expand-macros
+              pre-expand-resolve
+              driver-process-in-context
+              post-add-row-count-and-status
+              post-format-rows
+              pre-add-implicit-fields
+              pre-add-implicit-breakout-order-by
+              cumulative-sum
+              limit
+              post-annotate
+              pre-log-query
+              wrap-guard-multiple-calls
+              driver-process-query) (assoc query :driver driver))))))

 ;;; +----------------------------------------------------------------------------------------------------+


Resolve merge

Resolve merge

--- src/atom_finder/questions/all_nodes.clj
+++ src/atom_finder/questions/all_nodes.clj
@@ -6,6 +6,9 @@
    [atom-finder.util :refer :all]
    [atom-finder.atom-patch :refer :all]
    [atom-finder.questions.question-util :refer :all]
+   [clj-cdt.clj-cdt :refer :all]
+   [clj-cdt.expr-operator :refer :all]
+   [clj-cdt.writer-util :refer :all]
    [clojure.pprint :refer [pprint]]
    [clojure.string :as string]
    [swiss.arrows :refer :all]
@@ -19,8 +22,10 @@
   (-> node expr-operator :name (or (write-node-type node))))

 ;; List all node counts file-by-file
-'((prn (now)))
-'((->> atom-finder-corpus-path
+(defn count-all-nodes-in-project
+  [edn-file]
+  (prn (now))
+  (->> atom-finder-corpus-path
        (pmap-dir-c-files
         (fn [file]
           (assoc
@@ -28,21 +33,9 @@
            :file (atom-finder-relative-path file))))
        (map prn)
        dorun
-       (log-to "tmp/all-node-counts_2018-01-22_opname.edn")
+       (log-to edn-file)
        time-mins
        ))
-
-;; Total node counts in entire corpus
-'((->>
-   "tmp/all-node-counts_2018-01-22_opname.edn"
-   read-lines
-   (map (partial-right dissoc :file))
-   (apply merge-with +)
-   (sort-by (comp - last))
-   (map (partial zipmap [:node-type :count]))
-   (maps-to-csv "tmp/all-node-counts_2018-01-22_opname.csv")
-   time-mins
-   ))

 (defn c-files-no-cpp-or-h
   "Search directory structure for C-only files"
@@ -51,22 +44,22 @@
        files-in-dir
        (filter #(->> %1 .getName file-ext #{"c"} (and (.isFile %1))))))

-;; All node counts line-by-line - creates a big file
-'((->>
-   "~/opt/src/atom-finder/gecko-dev"
-   expand-home
-   c-files-no-cpp-or-h
-   (map parse-file)
-   (mapcat (%->> find-all-atoms-non-atoms ((flip dissoc) :all-nodes) (mapcat (fn [[k vs]] (map #(vector % k) vs)))))
-   (map (fn [[node atom-type]] (try
-                                 {:file (filename node)
-                                  :line (start-line node)
-                                  :ast (-> node opname-or-typename name)
-                                  :atom (-> atom-type name)}
-          (catch Exception e nil))
-          ))
-   (remove nil?)
-   (map (partial-right update-in [:file] #(.replaceAll % ".*gecko-dev/" "gecko-dev/")))
-   (maps-to-csv "gecko-node-lines.csv")
+(defn summarize-all-nodes [edn-file csv-file]
+  (->>
+   edn-file
+   read-lines
+   (map (partial-right dissoc :file))
+   (apply merge-with +)
+   (sort-by (comp - last))
+   (map (partial zipmap [:node-type :count]))
+   (maps-to-csv csv-file)
    time-mins
    ))
+
+(defn main-all-nodes
+  []
+  (let [edn-file "tmp/all-node-counts_2018-08-31_for-esem.edn"
+        csv-file "src/analysis/data/all-node-counts_2018-08-31_for-esem.csv"]
+    (count-all-nodes-in-project edn-file)
+    (summarize-all-nodes edn-file csv-file)
+  ))


Split out the code generator from the compiler

Signed-off-by: Greg Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/chaintool/platforms/golang/core.clj
+++ src/chaintool/platforms/golang/core.clj
@@ -167,22 +167,18 @@
     (protoc-cmd outputdir output)))

 ;;-----------------------------------------------------------------
-;; compile - generates all golang platform artifacts within the
-;; default location in the build area
-;;-----------------------------------------------------------------
-(defn compile [{:keys [path config output]}]
-  (dorun
-   (let [builddir (io/file path "build")
-         srcdir (io/file builddir "src")
-         intfdir (io/file path "src/interfaces")
-         interfaces (intf/compile intfdir config)]
+;; generate - generates all of our protobuf/go code based on the
+;; config
+;;-----------------------------------------------------------------
+(defn generate [{:keys [ipath opath config]}]
+  (let [interfaces (intf/compile ipath config)]

      ;; generate protobuf output
      (dorun (for [interface interfaces]
-              (emit-proto srcdir interface)))
+              (emit-proto opath interface)))

      ;; generate our primary shim/stub
-     (let [path (io/file srcdir "hyperledger/ccs")]
+     (let [path (io/file opath "hyperledger/ccs")]
        (let [content (render-primary-shim config interfaces)
              filename (io/file path "shim.go")]
          (emit-golang filename content))
@@ -196,23 +192,35 @@
        ;; first process all _except_ the appinit interface
        (dorun (for [name provides]
                 (let [functions (intf/getallfunctions (interfaces name))]
-                  (emit-server-shim name functions srcdir))))
+                  (emit-server-shim name functions opath))))

        ;; and now special case the appinit  interface
-       (emit-server-shim "appinit" {:transactions {1 {:rettype "void", :functionName "Init", :param "Init", :index 1, :subType nil, :typeName nil}}} srcdir))
+       (emit-server-shim "appinit" {:transactions {1 {:rettype "void", :functionName "Init", :param "Init", :index 1, :subType nil, :typeName nil}}} opath))

      ;; generate our client shims
      (dorun (for [name (intf/getconsumes config)]
               (let [functions (intf/getallfunctions (interfaces name))]
-                (emit-shim name functions "client" srcdir "client-shim.go"))))
-
-     ;; install go dependencies
-     (go-cmd path {} "get" "-d" "-v" "chaincode")
-
-     ;; build the actual code
-     (let [gobin (io/file builddir "bin")]
-       (io/make-parents (io/file gobin ".dummy"))
-       (io/make-parents output)
-       (go-cmd path {"GOBIN" (.getCanonicalPath gobin)} "build" "-o" (.getCanonicalPath output) "chaincode"))
-
-     (println "Compilation complete"))))
+                (emit-shim name functions "client" opath "client-shim.go"))))))
+
+;;-----------------------------------------------------------------
+;; compile - generates all golang platform artifacts within the
+;; default location in the build area
+;;-----------------------------------------------------------------
+(defn compile [{:keys [path config output]}]
+  (let [builddir (io/file path "build")]
+
+    ;; run our code generator
+    (generate {:ipath (io/file path "src/interfaces")
+               :opath (io/file builddir "src")
+               :config config})
+
+    ;; install go dependencies
+    (go-cmd path {} "get" "-d" "-v" "chaincode")
+
+    ;; build the actual code
+    (let [gobin (io/file builddir "bin")]
+      (io/make-parents (io/file gobin ".dummy"))
+      (io/make-parents output)
+      (go-cmd path {"GOBIN" (.getCanonicalPath gobin)} "build" "-o" (.getCanonicalPath output) "chaincode"))
+
+    (println "Compilation complete")))


fix cljx compilation

fix cljx compilation

--- src/clj/rksm/cloxp_cljs/compilation.clj
+++ src/clj/rksm/cloxp_cljs/compilation.clj
@@ -41,7 +41,7 @@
     (let [out-file (io/file (str project-dir "/target/classes/"
                                  (sf/ns-name->rel-path ns-name ".cljs")))]
       (-> out-file .getParentFile .mkdirs)
-      (spit out-file (.getClj (sf/file file))))))
+      (spit out-file (.getCljs (sf/file file))))))

 (defn compile-cljs-in-project
   [changed-ns file project-dir & [compiler-env]]


Start make lonn vs gjeld

Start make lonn vs gjeld

--- src/clj_simple_chart/ssb/data/gjeld.clj
+++ src/clj_simple_chart/ssb/data/gjeld.clj
@@ -1,6 +1,7 @@
 (ns clj-simple-chart.ssb.data.gjeld
   (:require [clj-simple-chart.ssb.data.ssb-api :as ssb]
             [clj-simple-chart.data.utils :refer :all]
+            [clj-simple-chart.ssb.data.lønnsvekst :as lonnsvekst]
             [clojure.set :as set]
             [clojure.string :as str]))

@@ -11,4 +12,9 @@

 (def data (->> (ssb/fetch 11599 q)
                (remove-nils)
-               (filter #(str/ends-with? (:Tid %) "-12"))))
+               (keep-columns [:Tid :ContentsCode])
+               (filter #(str/ends-with? (:Tid %) "-12"))
+               (map #(set/rename-keys % {:ContentsCode :gjeldsvekst}))
+               (map #(update % :Tid (fn [x] (subs x 0 4))))
+               (map #(assoc % :lonnsvekst (get lonnsvekst/data (read-string (:Tid %)))))
+               (remove-nils)))


Still not working...

Still not working...

--- src/cljs/clj_mini_apps/tic-tac-toe.cljs
+++ src/cljs/clj_mini_apps/tic-tac-toe.cljs
@@ -8,7 +8,7 @@
   (when (and js/document (.-getElementById js/document))
     (do (log "ttt init"))))

-(defn draw []
+(defn setup []
   ;Create background and outline
   (q/background 209 209 210)
   (q/fill 255)
@@ -19,9 +19,25 @@
   (q/rect 220 79 9 441)
   (q/rect 370 79 9 441)
   (q/rect 79 220 441 9)
-  (q/rect 79 370 441 9))
+  (q/rect 79 370 441 9)
+  (q/rect-mode CENTER)
+
+(defn draw
+  [{:keys [:rects]}]
+  (q/fill 255 0 0)
+  (doseq [{:keys [x y w h]} rects]
+    (q/rect x y w h)))
+
+(defn add-rect
+  [state {:keys [x y]}]
+  (log state)
+  (log mouse-x)
+  (update-in state [:rects]
+             conj {:x mouse-x :y mouse-y :w 10 :h 10}))

 (q/defsketch hello
+  :setup setup
   :draw draw
   :host "canvas"
-  :size [600 600])
+  :size [600 600]
+  :mouse-pressed add-rect)


wrong type of bounds!

wrong type of bounds!

--- src/cljs/infinitelives/pixi/sprite.cljs
+++ src/cljs/infinitelives/pixi/sprite.cljs
@@ -124,7 +124,7 @@
    (.-position.y sprite)])

 (defn get-rects [sprite]
-  (let [bounds (.getBounds sprite)]
+  (let [bounds (.getLocalBounds sprite)]
     [(.-x bounds) (.-y bounds) (.-width bounds) (.-height bounds)]))

 (defn get-edges [sprite]


Fix flow condition retries both retrying and

acking segments

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -173,14 +173,20 @@
   event)

 (s/defn flow-retry-segments :- Event
-  [{:keys [peer-replica-view state messenger monitoring] :as compiled}
-   {:keys [onyx.core/results] :as event} :- Event]
-  (doseq [root (:retries results)]
-    (when-let [site (peer-site peer-replica-view (:completion-id root))]
-      (emit-latency :peer-retry-segment
-                    monitoring
-                    #(extensions/internal-retry-segment messenger (:id root) site))))
-  event)
+  [{:keys [peer-replica-view state messenger monitoring] :as compiled}
+   event :- Event]
+  (let [retry-ids (set (map :id (:retries (:onyx.core/results event))))
+        event (update-in event
+                               [:onyx.core/results :acks]
+                               (fn [acks]
+                                 (filterv (comp not retry-ids :id) acks)))]
+    (doseq [root (:retries (:onyx.core/results event))]
+      (when-let [site (peer-site peer-replica-view (:completion-id root))]
+        (emit-latency
+         :peer-retry-segment
+         monitoring
+         #(extensions/internal-retry-segment messenger (:id root) site))))
+    event))

 (s/defn gen-lifecycle-id
   [event]


Remove unused lookups

Remove unused lookups

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -188,7 +188,7 @@
       (Thread/sleep (:onyx.core/drained-back-off event)))))

 (defn read-batch
-  [{:keys [peer-replica-view task-type pipeline job-id task-information] :as compiled}
+  [{:keys [peer-replica-view task-type pipeline] :as compiled}
    event]
   (if (and (= task-type :input) (:backpressure? @peer-replica-view))
     (assoc event :onyx.core/batch '())


Add checks for nil args in control-proxy sc-ugen and output-proxy

--- src/overtone/sc/ugen/sc_ugen.clj
+++ src/overtone/sc/ugen/sc_ugen.clj
@@ -1,5 +1,6 @@
 (ns overtone.sc.ugen.sc-ugen
-  (:use [overtone.sc.ugen defaults]))
+  (:use [overtone util]
+        [overtone.sc.ugen defaults]))

 (defrecord SCUGen [id name rate rate-name special args n-outputs])
 (derive SCUGen ::sc-ugen)
@@ -7,9 +8,17 @@
 (defn sc-ugen? [obj] (isa? (type obj) ::sc-ugen))

 (defn sc-ugen
-  "Create a new SCUGen instance"
+  "Create a new SCUGen instance. Throws an error if any of the args are nil."
   [id name rate rate-name special args n-outputs]
-  (SCUGen. id name rate rate-name special args n-outputs))
+  (if (or (nil? id)
+          (nil? name)
+          (nil? rate)
+          (nil? rate-name)
+          (nil? special)
+          (nil? args)
+          (nil? n-outputs))
+    (throw (IllegalArgumentException. (str "Attempted to create an SCUGen with nil args. Got " [id name rate rate-name special args n-outputs])))
+    (SCUGen. id name rate rate-name special args n-outputs)))

 (defn count-ugen-args
   "Count the number of ugens in the args of ug (and their args recursively)"
@@ -23,7 +32,7 @@
             args)))

 (defmethod print-method SCUGen [ug w]
-  (.write w (str "#<sc-ugen: " (:name ug) " with " (count-ugen-args ug) " internal sc-ugens>")))
+  (.write w (str "#<sc-ugen: " (overtone-ugen-name (:name ug)) (:rate-name ug) " [" (count-ugen-args ug) "]>")))

 (defrecord ControlProxy [name value rate rate-name])
 (derive ControlProxy ::sc-ugen)
@@ -31,18 +40,33 @@
 (defn control-proxy
   "Create a new control proxy with the specified name, value and rate. Rate
   defaults to :kr. Specifically handles :tr which is really a TrigControl
-  ugen at :kr."
+  ugen at :kr. Throws an error if any of the args are nil."
   ([name value] (control-proxy name value :kr))
-  ([name value rate]
-     (ControlProxy. name value (if (= :tr)
-                                 (:kr RATES)
-                                 (rate RATES)) rate)))
+  ([name value rate-name]
+     (let [rate (if (= :tr)
+                  (:kr RATES)
+                  (rate-name RATES))]
+       (if (or (nil? name)
+               (nil? value)
+               (nil? rate)
+               (nil? rate-name))
+         (throw (IllegalArgumentException. (str "Attempted to create a ControlProxy with nil args. Got " [name value rate rate-name])))
+         (ControlProxy. name value rate rate-name)))))

 (defrecord OutputProxy [ugen rate rate-name index])
 (derive OutputProxy ::sc-ugen)

-(defn output-proxy [ugen index]
-  (OutputProxy. ugen (:rate ugen) (REVERSE-RATES (:rate ugen)) index))
+(defn output-proxy
+  "Create a new output proxy. Throws an error if any of the args are nil."
+  [ugen index]
+  (let [rate (:rate ugen)
+        rate-name (REVERSE-RATES (:rate ugen))]
+    (if (or (nil? ugen)
+            (nil? rate)
+            (nil? rate-name)
+            (nil? index))
+      (throw (IllegalArgumentException. (str "Attempted to create an OutputProxy with nil args. Got " [ugen rate rate-name index])))
+      (OutputProxy. ugen rate rate-name index))))

 (defn control-proxy? [obj] (= ControlProxy (type obj)))


Add cards for reference views

Add cards for reference views

--- src/devcards/discuss/devcards/core.cljs
+++ src/devcards/discuss/devcards/core.cljs
@@ -39,7 +39,12 @@

 (defcard-om click-on-references
             "Show dialog when clicking on a reference."
-            ref/dialog
+            ref/dialog-view
+            lib/app-state)
+
+(defcard-om show-reference-usages
+            "Show usages of the current selected reference."
+            ref/usages-view
             lib/app-state)

 (deftest find-tests


(SERVER-1261) Add metrics print functions to dev-tools script

This commit adds some functions to the dev-tools script for printing
various metrics - http requests, profiler, and jruby metrics.  These
functions are copied in from the dev-tools namespace in PE puppetserver.

--- dev/dev_tools.clj
+++ dev/dev_tools.clj
@@ -22,7 +22,12 @@
             [puppetlabs.services.protocols.jruby-puppet :as jruby-protocol]
             [puppetlabs.services.jruby-pool-manager.jruby-core :as jruby-core]
             [puppetlabs.trapperkeeper.bootstrap :as bootstrap]
-            [puppetlabs.trapperkeeper.config :as config])
+            [puppetlabs.trapperkeeper.config :as config]
+            [puppetlabs.services.jruby.jruby-metrics-core :as jruby-metrics-core]
+            [puppetlabs.metrics :as metrics]
+            [puppetlabs.metrics.http :as http-metrics]
+            [puppetlabs.trapperkeeper.services :as tk-services]
+            [puppetlabs.services.puppet-profiler.puppet-profiler-core :as puppet-profiler-core])
   (:import (java.io File)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -150,6 +155,64 @@
   (jruby-protocol/flush-jruby-pool!
     (tka/get-service system :JRubyPuppetService)))

+(defn print-puppet-profiler-metrics
+  "Print metrics data about function calls, resources, catalog compile and file
+  metadata inlining."
+  []
+  (let [metrics-profiler (get-in (context)
+                                 [:service-contexts
+                                  :PuppetProfilerService
+                                  :profiler])
+        metrics (:experimental (puppet-profiler-core/assoc-metrics-data
+                                {}
+                                metrics-profiler))]
+    (pprint/pprint metrics)))
+
+(defn print-http-request-stats
+  "Print metrics data about requests we've handled, sorted in descending order
+  of time spent."
+  []
+  (let [metrics (-> (tka/get-service system :MasterService)
+                    tk-services/service-context
+                    :http-metrics)
+        request-stats (http-metrics/request-summary metrics)]
+    (pprint/pprint (:sorted-routes request-stats))))
+
+(defn print-jruby-metrics
+  []
+  (pprint/pprint (context [:service-contexts :JRubyMetricsService :metrics]))
+  (pprint/pprint
+   (let [{:keys [num-jrubies num-free-jrubies requested-count requested-jrubies-histo
+                 borrow-count borrow-timeout-count borrow-retry-count
+                 return-count free-jrubies-histo borrow-timer wait-timer
+                 requested-instances borrowed-instances
+                 lock-wait-timer lock-held-timer]}
+         (context [:service-contexts :JRubyMetricsService :metrics])]
+     {:num-jrubies (.getValue num-jrubies)
+      :num-free-jrubies (.getValue num-free-jrubies)
+      :requested-count (.getCount requested-count)
+      :borrow-count (.getCount borrow-count)
+      :borrow-timeout-count (.getCount borrow-timeout-count)
+      :borrow-retry-count (.getCount borrow-retry-count)
+      :return-count (.getCount return-count)
+      :average-requested-jrubies (metrics/mean requested-jrubies-histo)
+      :average-free-jrubies (metrics/mean free-jrubies-histo)
+      :average-borrow-time (metrics/mean-millis borrow-timer)
+      :average-wait-time (metrics/mean-millis wait-timer)
+      :requested-instances (jruby-metrics-core/requested-instances-info
+                            (vals @requested-instances))
+      :borrowed-instances (jruby-metrics-core/requested-instances-info
+                           (vals @borrowed-instances))
+      :num-pool-locks (.getCount lock-held-timer)
+      :average-lock-wait-time (metrics/mean-millis lock-wait-timer)
+      :average-lock-held-time (metrics/mean-millis lock-held-timer)})))
+
+(defn print-interesting-metrics
+  []
+  (print-puppet-profiler-metrics)
+  (print-http-request-stats)
+  (print-jruby-metrics))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Allow user overrides

@@ -159,4 +222,4 @@

 (let [user-overrides (File. "./dev/user.clj")]
   (if (.exists user-overrides)
-    (load-file (.getAbsolutePath user-overrides))))+    (load-file (.getAbsolutePath user-overrides))))


Worked out a useable plan for invariants.

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -248,7 +248,7 @@
          ~@etc)
        (let [chk# (contract ~(symbol (str "chk-" name))
                             ""
-                            [{:keys ~fields}] ~invariants)]
+                            [{:keys ~fields :as m#}] ~invariants)]

          (defconstrainedfn ~factory-name
            ([] [] (with-meta
@@ -262,49 +262,23 @@
                 {:contract chk#}))))
        ~name)))

+(defn- apply-contract [f]
+  (fn [m & args]
+    (if-let [contract (-> m meta :contract)]
+      ((partial contract identity) (apply f m args))
+      (apply f m args))))
+
+
 (comment
   (defconstrainedrecord Foo [a 1 b 2]
     [(every? number? [a b])]
     Object
     (toString [this] (str "record Foo has " a " and " b)))

-  ((:contract (meta (new-Foo))) #(assoc % :a :v) (new-Foo))
-  (identity (Foo. 1 3))
-
-  (macroexpand '  (defconstrainedrecord Foo [a 1 b 2]
-    [(every? number? [a b])]
-    Object
-    (toString [this] (str "record Foo has " a " and " b))))
-
-  (do
-    (clojure.core/defrecord Foo [a b] Object (toString [this] (str "record Foo has " a " and " b)))
-
-    (clojure.core/let [chk__213__auto__ (fogus.me.trammel/contract chk-Foo ""
-                                                                   [{:keys [a b]}]
-                                                                   [(every? number? [a b])])]
-                      (fogus.me.trammel/defconstrainedfn new-Foo
-                        ([] [] (clojure.core/with-meta (Foo. 1 2) {:contract chk__213__auto__}))
-                        ([& {:or {a 1, b 2}, :as kwargs__214__auto__, :keys [a b]}] [(every? number? [a b])]
-                           (clojure.core/with-meta
-                             (clojure.core/->
-                              (Foo. 1 2)
-                              (clojure.core/merge kwargs__214__auto__))
-                             {:contract chk__213__auto__}))))
-    Foo)
-
-  (macroexpand '(fogus.me.trammel/contract chk-Foo "" [[x y & z :as L] {:keys [a b] :as m} c d] [(every? number? [a b])]))

-  (clojure.core/with-meta
-    (fn chk-Foo
-      ([f {:keys [a b]}]
-         {:pre [(every? number? [a b])], :post []}
-         (f {:keys [a b]}))) {:constraints (clojure.core/into {} (quote ([[{:keys [a b]}] {:pre [(every? number? [a b])], :post []}])))})
+  (def a (wrap assoc))

-  (defn foo [[f & r :as x] {:keys [a b] :as m}]
-    [f r x a b m])
-
-  (foo [1 2 3] {:a 2 :b 3})
-  (? [1 2 3])
+  (a (new-Foo) :a 33 :b 45 :c 88)
 )