added get married

added get married

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -192,7 +192,19 @@
                         :sem {:pred :cancel}}}
    "cantar" {:synsem {:cat :verb
                         :sem {:pred :sing}}}
-   "casarse" {}
+   "casarse" (let [subject-semantics (atom {:human true})
+         subject-agr (atom :top)]
+     {:synsem {:cat :verb
+               :sem {:pred :get-married
+                     :reflexive true
+                     :subj subject-semantics
+                     :obj subject-semantics}
+               :subcat {:1 {:agr subject-agr
+                            :sem subject-semantics}
+                        :2 {:agr subject-agr
+                            :pronoun true
+                            :reflexive true
+                            :sem subject-semantics}}}})

    "cenar" {:synsem {:cat :verb
                        :sem {:pred :have-dinner}}}


fix typos

fix typos

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1509,23 +1509,22 @@
                          :sem {:pred :wear}}}]
    "potere"
    (let [shared-part-of-potere
-   {:synsem {:cat :verb}
-    :italiano {:future-stem "potr"
-    :drop-e true
-   :present {:1sing "posso"
-             :2sing "puoi"
-             :3sing "può"
-             :1plur "possiamo"
-             :2plur "potete"
-             :3plur "possono"}}}
-   [(merge shared-part-of-potere
+         {:synsem {:cat :verb}
+          :italiano {:future-stem "potr"
+                     :drop-e true
+                     :present {:1sing "posso"
+                               :2sing "puoi"
+                               :3sing "può"
+                               :1plur "possiamo"
+                               :2plur "potete"
+                               :3plur "possono"}}}]
+     [(merge shared-part-of-potere
              {:synsem {:pred :can}})
       (merge shared-part-of-potere
              {:synsem {:pred :may}})
-           (merge shared-part-of-potere
-             {:synsem {:pred :be-able-to}})])
-
-
+      (merge shared-part-of-potere
+             {:synsem {:pred :be-able-to}})])
+
    "prendere" {:synsem {:cat :verb :sem {:pred :take}}
                :italiano {:passato "preso"}}


Print stack trace when catching error in a thread

--- src/braid/core/server/core.clj
+++ src/braid/core/server/core.clj
@@ -52,7 +52,8 @@
   (Thread/setDefaultUncaughtExceptionHandler
     (reify Thread$UncaughtExceptionHandler
       (uncaughtException [_ thread ex]
-        (timbre/errorf "Uncaught exception %s on %s" ex (.getName thread))))))
+        (timbre/errorf "Uncaught exception %s on %s" ex (.getName thread))
+        (.printStackTrace ex)))))

 (defstate thread-handler
   :start (set-default-exception-handler))


implement dummy access-denied-exception? in smb-fs

--- src/brainbot/nozzle/smb_fs.clj
+++ src/brainbot/nozzle/smb_fs.clj
@@ -40,6 +40,9 @@

 (defrecord SmbFilesystem [root auth]
   vfs/Filesystem
+  (access-denied-exception? [fs err]
+    false) ; XXX
+
   (extract-content [fs entry]
     (let [smb-file (smb-file-for-entry fs entry)]
       (with-open [in (.getInputStream smb-file)]


curry the guitar instrument in note-sequence play fn

--- src/functional_music/core.clj
+++ src/functional_music/core.clj
@@ -1,4 +1,4 @@
-(ns functional-music.core
+( ns functional-music.core
   (:require [functional-music.tab :as tab]
             [overtone.live :refer :all]
             [overtone.synth.stringed :refer :all]
@@ -21,10 +21,11 @@
    string-index-2 fret-index-2 ... ]]
    "
   [interval noteseq]
-  (let [timeseq  (range (now) (+ (now) (* interval (count noteseq))) interval)]
+  (let [playguitar (partial guitar-pick (guitar))  ;; curry the guitar instrument
+        timeseq    (range (now) (+ (now) (* interval (count noteseq))) interval)]
     (doseq [[string-fret-seq timeval] (map vector noteseq timeseq)]
       (doseq [[string fret] string-fret-seq]
-        (guitar-pick (guitar) string fret timeval)))))
+        (playguitar string fret timeval)))))

 (def playguitar320
   (partial guitar-pick-note-sequence 320))  ;; 320ms delay between picked strings


functions work. New macro for composing conversions together.

--- src/clj/forma/source/modis.clj
+++ src/clj/forma/source/modis.clj
@@ -70,8 +70,10 @@
 (defn scale
   "Scales each element in a collection of numbers by the supplied
   factor."
-  [fact sequence]
-  (for [x sequence] (* x fact)))
+  ([fact sequence]
+     (scale fact 0 sequence))
+  ([fact offset sequence]
+     (for [x sequence] (-> x (* fact) (+ offset)))))

 ;; From [Wikipedia](http://goo.gl/qG7Hi), "the sinusoidal projection
 ;; is a pseudocylindrical equal-area map projection, sometimes called
@@ -102,19 +104,6 @@
 ;; we need these values to appropriately map between meters and pixels
 ;; on the subdivided grid.

-(defn latlon-rad->sinu-xy
-  "Returns the sinusoidal x and y coordinates for the supplied
-  latitude and longitude (in radians)."
-  [lat lon]
-  (scale rho [(* (cos lat) lon) lat]))
-
-(defn latlon-deg->sinu-xy
-  "Returns the sinusoidal x and y coordinates for the supplied
-  latitude and longitude (in degrees)."
-  [lat lon]
-  (apply latlon-rad->sinu-xy
-         (map #(Math/toRadians %) [lat lon])))
-
 ;; These are the meter values of the minimum possible x and y values
 ;; on a sinusoidal projection. The sinusoidal projection is quite
 ;; deformed at the corners, so we compute the minimum x and y values
@@ -123,11 +112,40 @@
 (defn x-coord [point] (first point))
 (defn y-coord [point] (second point))

-(def min-x (x-coord (latlon-deg->sinu-xy 0 -180)))
-(def min-y (y-coord (latlon-deg->sinu-xy -90 0)))
-(def max-y (y-coord (latlon-deg->sinu-xy 90 0)))
-
-(defn sinu-position
+(def min-x (x-coord (latlon->sinu-xy 0 -180)))
+(def min-y (y-coord (latlon->sinu-xy -90 0)))
+(def max-y (y-coord (latlon->sinu-xy 90 0)))
+
+(defn pixel-length
+  "The length, in meters, of the edge of a MODIS pixel at the supplied
+  resolution."
+  [res]
+  (let [pixel-span (/ (- max-y min-y) v-tiles)
+        total-pixels (pixels-at-res res)]
+    (/ pixel-span total-pixels)))
+
+;; RENAME this. We have a few units here -- we have the global-xy, and
+;; then we have this global meters business. THINK! I think that
+;; sinu-xy is the actual meters value...
+;;
+;; NOTES -- conventions on naming. SL is sample, line -- xy is
+;; actually meters.
+;;
+;; TODO: -- add test to new thread-expr library
+;; TODO: -- get the translation from latlon->modis working
+
+(defn modis->global-mags
+  "Returns the (sample, line) of a pixel on the global MODIS grid,
+  measured in pixels from (0,0) at the top left."
+  [res mod-h mod-v sample line]
+  (let [edge-length (pixel-length res)
+        edge-pixels (pixels-at-res res)]
+    (->> [mod-h mod-v]
+         (scale edge-pixels)
+         (map + [sample line])
+         (scale edge-length (/ edge-length 2)))))
+
+(defn global-mags->sinu-xy
   "Returns the coordinate position on a sinusoidal grid reached after
   traveling the supplied magnitudes in the x and y directions. The
   origin of the sinusoidal grid is fixed in the top left corner."
@@ -136,31 +154,6 @@
                  (dir start magnitude))]
     (map travel [+ -] [min-x max-y] [mag-x mag-y])))

-(defn pixel-length
-  "The length, in meters, of the edge of a MODIS pixel at the supplied
-  resolution."
-  [res]
-  (let [pixel-span (/ (- max-y min-y) v-tiles)
-        total-pixels (pixels-at-res res)]
-    (/ pixel-span total-pixels)))
-
-(defn pixel-coords
-  "Returns the (sample, line) of a pixel on the global MODIS grid,
-  measured in pixels from (0,0) at the top left."
-  [mod-h mod-v sample line res]
-  (let [edge-pixels (pixels-at-res res)]
-    (map + [sample line] (scale edge-pixels [mod-h mod-v]))))
-
-(defn modis->sinu-xy
-  "Returns the map position in meters of the supplied MODIS tile
-  coordinate at the specified resolution."
-  [res mod-h mod-v sample line]
-  (let [edge-length (pixel-length res)
-        half-edge (/ edge-length 2)
-        pix-pos (pixel-coords mod-h mod-v sample line res)
-        magnitudes (map #(+ half-edge %) (scale edge-length pix-pos))]
-    (apply sinu-position magnitudes)))
-
 ;; ### Inverse Sinusoidal Projection
 ;;
 ;; We'll stay in degrees, here. To convert from MODIS to (lat, lon),
@@ -168,6 +161,19 @@
 ;; `[0 0]`, pixel `[0 0]`) in pixels into distance from the sinusoidal
 ;; origin (`[0 0]` in meters, corresponding to (lat, lon) = `[-90
 ;; -180]`).
+
+(defn latlon-rad->sinu-xy
+  "Returns the sinusoidal x and y coordinates for the supplied
+  latitude and longitude (in radians)."
+  [lat lon]
+  (scale rho [(* (cos lat) lon) lat]))
+
+(defn latlon->sinu-xy
+  "Returns the sinusoidal x and y coordinates for the supplied
+  latitude and longitude (in degrees)."
+  [lat lon]
+  (apply latlon-rad->sinu-xy
+         (map #(Math/toRadians %) [lat lon])))

 (defn sinu-xy->latlon
   "Returns the latitude and longitude (in degrees) for a given set of
@@ -177,10 +183,20 @@
         lon (/ x (* rho (cos lat)))]
     (map #(Math/toDegrees %) [lat lon])))

-(def
-  ^{:doc "Returns the latitude and longitude for the centroid of the
-  supplied MODIS tile coordinate at the specified resolution."}
-  modis->latlon
-  (comp (partial apply sinu-xy->latlon)
-        modis->sinu-xy))
-
+(defmacro conversion-comp
+  [& conversions]
+  `(fn [& args#]
+     (reduce (fn [val-seq# f#]
+               (apply f# val-seq#))
+             args#
+             [~@conversions])))
+
+;; Returns the map position in meters of the supplied MODIS tile
+;;  coordinate at the specified resolution
+
+(def modis->latlon
+  (conversion-comp modis->global-mags
+                   global-mags->sinu-xy
+                    sinu-xy->latlon))
+
+;; TODO -- get the damned global pixel


:ffi:

:ffi:

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -86,6 +86,7 @@
    (train-coffee :badger :mushroom)
    (train-coffee :coffeepot :heart)
    (train-coffee :simply_overcaffeinated :coffeespin)
+   (train :ffi :coffee)
    (train :blockchain)
    (train :coffeealarm)
    (train :nespresso :ali)


Revert "Construct ConsoleReader using System/in and System/out"

This reverts commit 0f4b5fb46274f90e6279b6d775355be220096ca2.

refs #81

--- src/clj/reply/reader/jline.clj
+++ src/clj/reply/reader/jline.clj
@@ -30,7 +30,7 @@
 (defn make-reader [options]
   (when (= "dumb" (System/getenv "TERM"))
     (.setProperty (Configuration/getProperties) "jline.terminal" "none"))
-  (let [reader (ConsoleReader. System/in System/out)
+  (let [reader (ConsoleReader.)
         history (FileHistory. (make-history-file (:history-file options)))
         completer (jline.completion/make-completer reply.initialization/eval-in-user-ns #())]
     (.setBlinkMatchingParen (.getKeys reader) true)


add gdpr status into to ctx

add gdpr status into to ctx

--- src/clj/salava/core/layout.clj
+++ src/clj/salava/core/layout.clj
@@ -70,6 +70,7 @@
                    :private         (private? ctx)
                    :footer          (get-in ctx [:config :extra/theme :footer] nil)
                    :factory-url     (get-in ctx [:config :factory :url])
+                   :gdpr-disabled?  (first (mapcat #(get-in ctx [:config % :disable-gdpr] []) (get-plugins ctx)))
                    }]
     (str "function salavaCoreCtx() { return " (json/write-str ctx-out) "; }")))


Fix merge-index

Fix merge-index

--- src/cljam/bam_index/writer.clj
+++ src/cljam/bam_index/writer.clj
@@ -52,20 +52,6 @@
 (defn pos->lidx-offset
   [pos]
   (bit-shift-right (if (<= pos 0) 0 (dec pos)) bam-lidx-shift))
-
-(defn- optimize-lidx
-  "Optimizes the linear index for safety. This seems unnecessary, but samtools
-  does this process."
-  [lidx largest-lidx-seen]
-  (loop [i 0
-         lidx* []
-         last-non-zero 0]
-    (if (<= i largest-lidx-seen)
-      (let [l (long (nth lidx i))]
-        (if (zero? l)
-          (recur (inc i) (conj lidx* last-non-zero) last-non-zero)
-          (recur (inc i) (conj lidx* l) l)))
-      lidx*)))

 (defn- init-meta-data []
   {:first-offset  -1
@@ -137,6 +123,21 @@
                  lidx*))
       :largest-seen (max win-end largest-seen))))

+(defn- finish-linear-index
+  "Optimizes the linear index for safety. This seems unnecessary, but samtools
+  does this process."
+  [linear-index]
+  (let [{lidx :index, largest-lidx-seen :largest-seen} linear-index]
+   (loop [i 0
+          lidx* []
+          last-non-zero 0]
+     (if (<= i largest-lidx-seen)
+       (let [l (long (nth lidx i))]
+         (if (zero? l)
+           (recur (inc i) (conj lidx* last-non-zero) last-non-zero)
+           (recur (inc i) (conj lidx* l) l)))
+       lidx*))))
+
 (defn- init-index-status []
   {:meta-data    (init-meta-data)
    :bin-index    (init-bin-index)
@@ -167,28 +168,27 @@
                                   no-coordinate-alns)
             indices' (if new-ref?
                        (assoc indices ref-name {:meta (:meta-data idx-status)
-                                                :bins (finish-bin-index (:bin-index idx-status))
-                                                :lidx (optimize-lidx (:index (:linear-index idx-status))
-                                                                     (:largest-seen (:linear-index idx-status)))})
+                                                :bins (:bin-index idx-status)
+                                                :lidx (:linear-index idx-status)})
                        indices)]
         (recur rest ref-name' idx-status' no-coordinate-alns' indices'))
       (assoc indices ref-name {:meta (:meta-data idx-status)
-                               :bins (finish-bin-index (:bin-index idx-status))
-                               :lidx (optimize-lidx (:index (:linear-index idx-status))
-                                                    (:largest-seen (:linear-index idx-status)))}
+                               :bins (:bin-index idx-status)
+                               :lidx (:linear-index idx-status)}
                      :no-coordinate-alns no-coordinate-alns))))

 (defn make-index
   [refs alns]
-  (merge
-   (zipmap (map :name refs)
-           (map (fn [r] {:meta {:first-offset -1
-                                :last-offset 0
-                                :aligned-alns 0
-                                :unaligned-alns 0}
-                         :bins {}
-                         :lidx []}) refs))
-   (make-index* refs alns)))
+  (->> alns
+       (make-index* refs)
+       (finish-index refs)))
+
+(defn make-index1
+  [refs alns]
+  (->> (partition-all 40 alns)
+       (map (partial make-index* refs))
+       (apply merge-index)
+       (finish-index refs)))

 ;;;
 ;;; Merge indices
@@ -196,7 +196,11 @@

 (defn- merge-meta
   [meta1 meta2]
-  {:first-offset (min (:first-offset meta1) (:first-offset meta2))
+  {:first-offset (let [offsets (filter (partial not= -1) [(:first-offset meta1) (:first-offset meta2)])]
+                   (cond
+                    (> (count offsets) 1) (apply min offsets)
+                    (= (count offsets) 1) (first offsets)
+                    :else -1))
    :last-offset (max (:last-offset meta1) (:last-offset meta2))
    :aligned-alns (+ (:aligned-alns meta1) (:aligned-alns meta2))
    :unaligned-alns (+ (:unaligned-alns meta1) (:unaligned-alns meta2))})
@@ -207,18 +211,13 @@
       (chunk/optimize-chunks 0)))

 (defn- merge-bins
-  [bins1 bins2]
-  (let [bins->bin-map (fn [bins]
-                        (zipmap (map :bin bins)
-                                (map :chunks bins)))
-        bin-map1 (bins->bin-map bins1)
-        bin-map2 (bins->bin-map bins2)]
-    (-> (merge-with merge-chunks bin-map1 bin-map2)
-        (finish-bin-index))))
+  [bin-map1 bin-map2]
+  (merge-with merge-chunks bin-map1 bin-map2))

 (defn- merge-lidx
   [lidx1 lidx2]
-  (concat lidx1 lidx2))
+  {:index (map min (:index lidx1) (:index lidx2))
+   :largest-seen (max (:largest-seen lidx1) (:largest-seen lidx2))})

 (defn merge-index
   [& indices]
@@ -256,13 +255,24 @@
   (lsb/write-long w (:aligned-alns meta-data))
   (lsb/write-long w (:unaligned-alns meta-data)))

+(defn- finish-index
+  [refs index]
+  (loop [[f & r] refs
+         index index]
+    (if f
+      (let [rname (:name f)]
+        (recur r (-> index
+                     (update-in [rname :bins] finish-bin-index)
+                     (update-in [rname :lidx] finish-linear-index))))
+      index)))
+
 (defn- write-index*!
   [wtr refs alns]
   ;; magic
   (lsb/write-bytes wtr (.getBytes bai-magic))
   ;; n_ref
   (lsb/write-int wtr (count refs))
-  (let [indices (make-index refs alns)]
+  (let [indices (make-index1 refs alns)] ; TODO: parallelize
     (doseq [ref refs]
       (let [index (get indices (:name ref))
             n-bin (count (:bins index))]


move state further up the call-chain to make sure polling is only started once

--- src/cljs/lambdacd/ui_core.cljs
+++ src/cljs/lambdacd/ui_core.cljs
@@ -25,8 +25,8 @@
 (defn poll-history [history-atom]
   (poll history-atom api/get-build-history))

-(defn poll-state [history-atom build-number]
-  (poll history-atom #(api/get-build-state build-number)))
+(defn poll-state [state-atom build-number-atom]
+  (poll state-atom #(api/get-build-state @build-number-atom)))

 (defn history-item-component [{build-number :build-number status :status}]
   [:li {:key build-number} [:a {:href (route/for-build-number build-number)} (str "Build " build-number)]])
@@ -53,14 +53,10 @@
    [output-component build-state-atom step-id-to-display-atom]])

-(defn root [build-number-atom step-id-to-display-atom]
-  (let [history (atom [])
-        state (atom [])
-        build-number @build-number-atom]
+(defn root [build-number-atom step-id-to-display-atom history state]
+  (let [build-number @build-number-atom]
     (if build-number
       (do
-        (poll-history history)
-        (poll-state state build-number)
         [:div
          [:div {:id "builds"} [build-history-component history]]
           [:div {:id "currentBuild"} [current-build-component state build-number step-id-to-display-atom]]])
@@ -85,9 +81,13 @@

 (defn init! []
   (let [build-number-atom (atom nil)
-        step-id-to-display-atom (atom nil)]
+        step-id-to-display-atom (atom nil)
+        history-atom (atom [])
+        state-atom (atom [])]
+    (poll-history history-atom)
+    (poll-state state-atom build-number-atom)
     (hook-browser-navigation! build-number-atom step-id-to-display-atom)
     ; #' is necessary so that fighweel can update: https://github.com/reagent-project/reagent/issues/94
-    (reagent/render-component [#'root build-number-atom step-id-to-display-atom] (.getElementById js/document "app"))))
+    (reagent/render-component [#'root build-number-atom step-id-to-display-atom history-atom state-atom] (.getElementById js/document "app"))))


make fancy-log styles even more fancier

make fancy-log styles even more fancier

--- src/common/plastic/logging.clj
+++ src/common/plastic/logging.clj
@@ -54,21 +54,28 @@
          (.profileEnd js/console)
          (throw e#)))))

+(defmacro padding [s len]
+  `(let [padlen# (- ~len (count ~s))]
+     (apply str (repeat padlen# " "))))
+
 (defmacro pad-str [s len]
-  `(let [padlen# (- ~len (count ~s))]
-     (str (apply str (repeat padlen# " ")) ~s)))
+  `(let [s# ~s]
+     (str (padding s# ~len) s#)))

 (defmacro fancy-log-with-time [time label & args]
   `(let [thread# (or plastic.globals.*current-thread* "JS")
          label# ~label
          thread-color# (case thread#
-                         "JS" "black"
-                         "MAIN" "green"
-                         "WORKER" "orange"
-                         "red")]
-     (log "%c%s%c%s%c%s"
+                         "JS" "DimGray"
+                         "RENDER" "DarkPurple"
+                         "MAIN" "DarkGreen"
+                         "WORKER" "DarkOrange"
+                         "red")
+         thread-style# (str "background-color:" thread-color# ";border-radius:2px;color:white;")]
+     (log "%c%s%s%c%s%c%s"
        "color:#aaa" (pad-str ~time 10)
-       (str "color:" thread-color#) (if thread# (pad-str (str "[" thread# "]") 10) "")
+       (padding thread# 10)
+       thread-style# (if thread# (str " " thread# " ") "")
        "color:blue" (if label# (pad-str (str label# ":") 16) "")
        ~@args)))


RS | #0 | Conditionally wrap-ssl-redirect

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -100,7 +100,11 @@
       wrap-flash
       (wrap-session {:cookie-attrs {:http-only true}})
       (wrap-xss-protection true {:mode :block})
-      (wrap-frame-options :sameorigin)))
+      (wrap-frame-options :sameorigin)
+      ((if (config/get-var "HTTPS_ONLY")
+         wrap-ssl-redirect
+         identity))
+      ))

 (defonce server (atom nil))
 (defonce scheduler (atom nil))


Fix inlined images.

Fix inlined images.

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -52,7 +52,7 @@
         inline-file (str uuid-fragment ".inline.html")]
     (try
       (spit html-file (content/snapshot-html (assoc snapshot :note note))) ; create the email in a tmp file
-      (shell/sh "juice" html-file inline-file) ; inline the CSS
+      (shell/sh "juice" "--web-resources-images" "false" html-file inline-file) ; inline the CSS
       (email-snapshots msg (slurp inline-file)) ; email it to the recipients
       (finally
         ; remove the tmp files
@@ -71,7 +71,7 @@
                     (assoc :subject (content/invite-subject message)))]
     (try
       (spit html-file (content/invite-html invitation)) ; create the email in a tmp file
-      (shell/sh "juice" html-file inline-file) ; inline the CSS
+      (shell/sh "juice" "--web-resources-images" "false" html-file inline-file) ; inline the CSS
       (email invitation {:text (content/invite-text invitation)
                          :html (slurp inline-file)}) ; email it to the recipients
       (finally


fix for doubles at mondays

fix for doubles at mondays

--- src/ontrail/weekly.clj
+++ src/ontrail/weekly.clj
@@ -56,7 +56,7 @@
   (let [midnight (time/date-time (time/year dt) (time/month dt) (time/day dt))
         dow (time/day-of-week midnight)
         week-starts (time/minus midnight (time/days (- dow 1)))
-        week-stops (time/plus midnight (time/days (- 8 dow)))]
+        week-stops (time/minus (time/plus midnight (time/days (- 8 dow))) (time/hours 5))]
     (time/interval week-starts week-stops)))

 (defn interval-query [user start end]


update keyword with namespace

update keyword with namespace

--- src/graphql_clj/validation.clj
+++ src/graphql_clj/validation.clj
@@ -9,41 +9,43 @@
 ;; Zipper

 (def ^:private node-type->children-fn
-  {:type-definition :fields
-   :field :selection-set
-   :operation-definition :selection-set
-   :operations-definitions :operation-definition
-   :interface-definition :fields
-   :input-definition :fields
-   :statement-root :children
-   :fragment-definition :selection-set
-   :inline-fragment :selection-set})
+  {:graphql-clj/type-definition :graphql-clj/type-fields
+   :graphql-clj/field :graphql-clj/selection-set
+   :graphql-clj/operation-definition :graphql-clj/selection-set
+   :graphql-clj/operations-definitions :graphql-clj/operation-definition
+   :graphql-clj/interface-definition :graphql-clj/fields
+   :graphql-clj/input-definition :graphql-clj/fields
+   :graphql-clj/statement-root :graphql-clj/children
+   :graphql-clj/fragment-definition :graphql-clj/selection-set
+   :graphql-clj/inline-fragment :graphql-clj/selection-set})

 (def ^:private node-type->make-node-fn
   (let [assoc-field-fn (fn [k]
                          (fn [node children]
+                           (println "update node:" node)
                            (assoc node k children :changed "visited")))]
-    {:type-definition (assoc-field-fn :fields)
-     :field (assoc-field-fn :selection-set)
-     :operation-definition (assoc-field-fn :selection-set)
-     :operations-definitions (assoc-field-fn :operation-definition)
-     :interface-definition (assoc-field-fn :fields)
-     :input-definition (assoc-field-fn :fields)
-     :statement-root (assoc-field-fn :children)
-     :fragment-definition (assoc-field-fn :selection-set)
-     :inline-fragment (assoc-field-fn :selection-set)}))
+    {:graphql-clj/type-definition (assoc-field-fn :graphql-clj/type-fields)
+     :graphql-clj/field (assoc-field-fn :graphql-clj/selection-set)
+     :graphql-clj/operation-definition (assoc-field-fn :graphql-clj/selection-set)
+     :graphql-clj/operations-definitions (assoc-field-fn :graphql-clj/operation-definition)
+     :graphql-clj/interface-definition (assoc-field-fn :graphql-clj/fields)
+     :graphql-clj/input-definition (assoc-field-fn :graphql-clj/fields)
+     :graphql-clj/statement-root (assoc-field-fn :graphql-clj/children)
+     :graphql-clj/fragment-definition (assoc-field-fn :graphql-clj/selection-set)
+     :graphql-clj/inline-fragment (assoc-field-fn :graphql-clj/selection-set)}))

 (defn node-branch? [node]
-  (assert (:node-type node) "node-type should not be null for checking 'node-branch?'.")
-  (let [node-type (:node-type node)]
+  (assert (:graphql-clj/node-type node) "node-type should not be null for checking 'node-branch?'.")
+  (let [node-type (:graphql-clj/node-type node)]
+    (println "node-branch?:" (contains? (set (keys node-type->children-fn)) node-type))
     (if (contains? (set (keys node-type->children-fn)) node-type)
       true
       (println "error: node has no branch." node-type))))

 (defn node->children
   [node]
-  (assert (:node-type node) "node-type should not be null for node->children!")
-  (let [node-type (:node-type node)
+  (assert (:graphql-clj/node-type node) "node-type should not be null for node->children!")
+  (let [node-type (:graphql-clj/node-type node)
         children-fn (get node-type->children-fn node-type)]
     (if children-fn
       (children-fn node)
@@ -51,19 +53,19 @@

 (defn make-node-with-node-type
   [node children]
-  (assert (:node-type node) "node-type should not be null for make-node-with-node-type!")
-  (let [node-type (:node-type node)
+  (assert (:graphql-clj/node-type node) "node-type should not be null for make-node-with-node-type!")
+  (let [node-type (:graphql-clj/node-type node)
         make-node-fn (get node-type->make-node-fn node-type)]
     (if make-node-fn
       (make-node-fn node children)
       (println "error: make-node-fn not found!" node-type))))

 (defn branch? [node]
-  (println "branch?" (keys node) "node-type:" (:node-type node))
+  (println "branch?" (keys node) "node-type:" (:graphql-clj/node-type node))
   (cond
-    (:operation-definitions node) true
-    (:type-system-definitions node) true
-    (:node-type node) (node-branch? node)
+    (:graphql-clj/operation-definitions node) true
+    (:graphql-clj/type-system-definitions node) true
+    (:graphql-clj/node-type node) (node-branch? node)
     :default (do
                (println "error: don't know how to create branch for node:" node)
                false)))
@@ -73,9 +75,9 @@
   (println "make-node-fn:" (keys node))
   (if (map? node)
     (cond
-      (:operation-definitions node) (assoc node :operation-definitions children)
-      (:type-system-definitions node) (assoc node :type-system-definitions children)
-      (:node-type node) (make-node-with-node-type node children)
+      (:graphql-clj/operation-definitions node) (assoc node :graphql-clj/operation-definitions children)
+      (:graphql-clj/type-system-definitions node) (assoc node :graphql-clj/type-system-definitions children)
+      (:graphql-clj/node-type node) (make-node-with-node-type node children)
       :default (println "error: node is not a map!" node))
     (println "error: don't know how to make node from:" node "--- map?:" (map? node))))

@@ -83,10 +85,10 @@
   [node]
   (println "children:" (keys node))
   (cond
-    (:operation-definitions node) (do
-                                    (:operation-definitions node))
-    (:type-system-definitions node) (:type-system-definitions node)
-    (:node-type node) (node->children node)
+    (:graphql-clj/operation-definitions node) (do
+                                                (:graphql-clj/operation-definitions node))
+    (:graphql-clj/type-system-definitions node) (:graphql-clj/type-system-definitions node)
+    (:graphql-clj/node-type node) (node->children node)
     :default (do
                (println "error: no children for node:" node)
                nil)))
@@ -96,7 +98,7 @@
   (z/zipper branch? children make-node-fn document))

 (zv/defvisitor type-field-visitor :pre [n s]
-  (if (= :type-field (:node-type n))
+  (if (= :graphql-clj/type-field (:graphql-clj/node-type n))
     {:node (assoc n :changed "visited")
      :state s}))


Use = in deref as well, for consistency

Use = in deref as well, for consistency

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -308,7 +308,8 @@
         (set! state res)
         ;; Use = to determine equality from reactions, since
         ;; they are likely to produce new data structures.
-        (when (not= oldstate res)
+        (when (and (some? watches)
+                   (not= oldstate res))
           (-notify-watches this oldstate res)))
       res))

@@ -319,8 +320,10 @@
       (when-not (== dirtyness clean)
         (let [oldstate state
               newstate (f)]
-          (when-not (identical? oldstate newstate)
-            (-notify-watches this oldstate (set! state newstate)))))
+          (set! state newstate)
+          (when (and (some? watches)
+                     (not= oldstate newstate))
+            (-notify-watches this oldstate newstate))))
       (do
         (notify-deref-watcher! this)
         (when-not (== dirtyness clean)


Big cleanup of ratom.cljs

Big cleanup of ratom.cljs

Use a couple of utility functions, and better formatting to
reduce noise.

Don't use some? in performance critical code - avoid a function call.

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -8,7 +8,7 @@
 (defonce cached-reactions {})

 (defn ^boolean reactive? []
-  (some? *ratom-context*))
+  (not (nil? *ratom-context*)))

 (defonce ^boolean debug false)
 (defonce ^boolean silent false)
@@ -29,7 +29,7 @@
     (f)))

 (defn captured [obj]
-  (when (some? (.-cljsCaptured obj))
+  (when-not (nil? (.-cljsCaptured obj))
     obj))

 (defn- -captured [obj]
@@ -58,6 +58,19 @@
   (when debug
     (swap! -running + (- (count new) (count old))))
   new)
+
+(defn- add-w [this key f]
+  (let [w (.-watches this)]
+    (set! (.-watches this) (check-watches w (assoc w key f)))))
+
+(defn- remove-w [this key]
+  (let [w (.-watches this)]
+    (set! (.-watches this) (check-watches w (dissoc w key)))))
+
+(defn- pr-atom [a writer opts s]
+  (-write writer (str "#<" s " "))
+  (pr-writer (binding [*ratom-context* nil] (-deref a)) writer opts)
+  (-write writer ">"))

 ;;; Atom
@@ -87,34 +100,23 @@
       new-value))

   ISwap
-  (-swap! [a f]
-    (-reset! a (f state)))
-  (-swap! [a f x]
-    (-reset! a (f state x)))
-  (-swap! [a f x y]
-    (-reset! a (f state x y)))
-  (-swap! [a f x y more]
-    (-reset! a (apply f state x y more)))
+  (-swap! [a f]          (-reset! a (f state)))
+  (-swap! [a f x]        (-reset! a (f state x)))
+  (-swap! [a f x y]      (-reset! a (f state x y)))
+  (-swap! [a f x y more] (-reset! a (apply f state x y more)))

   IMeta
   (-meta [_] meta)

   IPrintWithWriter
-  (-pr-writer [a writer opts]
-    (-write writer "#<Atom: ")
-    (pr-writer state writer opts)
-    (-write writer ">"))
+  (-pr-writer [a w opts] (pr-atom a w opts "Atom:"))

   IWatchable
-  (-notify-watches [this oldval newval]
-    (reduce-kv (fn [_ key f]
-                 (f key this oldval newval)
-                 nil)
+  (-notify-watches [this old new]
+    (reduce-kv (fn [_ k f] (f k this old new) nil)
                nil watches))
-  (-add-watch [this key f]
-    (set! watches (check-watches watches (assoc watches key f))))
-  (-remove-watch [this key]
-    (set! watches (check-watches watches (dissoc watches key))))
+  (-add-watch [this key f]  (add-w this key f))
+  (-remove-watch [this key] (remove-w this key))

   IHash
   (-hash [this] (goog/getUid this)))
@@ -133,19 +135,19 @@
 (defn- cached-reaction [f key obj destroy]
   (if-some [r (get cached-reactions key)]
     (-deref r)
-    (if (some? *ratom-context*)
+    (if-not (nil? *ratom-context*)
       (let [r (make-reaction
                f :on-dispose (fn [x]
                                (set! cached-reactions
                                      (dissoc cached-reactions key))
-                               (when (some? obj)
+                               (when-not (nil? obj)
                                  (set! (.-reaction obj) nil))
-                               (when (some? destroy)
+                               (when-not (nil? destroy)
                                  (destroy x))
                                nil))
             v (-deref r)]
         (set! cached-reactions (assoc cached-reactions key r))
-        (when (some? obj)
+        (when-not (nil? obj)
           (set! (.-reaction obj) r))
         v)
       (f))))
@@ -165,14 +167,10 @@
          (= key (.-key other))))

   IHash
-  (-hash [this] (hash key))
+  (-hash [_] (hash key))

   IPrintWithWriter
-  (-pr-writer [a writer opts]
-    (-write writer (str "#<Track: " key " "))
-    (binding [*ratom-context* nil]
-      (pr-writer (-deref a) writer opts))
-    (-write writer ">")))
+  (-pr-writer [a w opts] (pr-atom a w opts "Track:")))

 (defn make-track [f args]
   (Track. #(apply f args) [f args] nil))
@@ -212,7 +210,7 @@
   (_set-state [this oldstate newstate]
     (when-not (identical? oldstate newstate)
       (set! state newstate)
-      (when (some? watches)
+      (when-not (nil? watches)
         (-notify-watches this oldstate newstate))))

   IDeref
@@ -239,32 +237,23 @@
       new-value))

   ISwap
-  (-swap! [a f]
-    (-reset! a (f (._peek a))))
-  (-swap! [a f x]
-    (-reset! a (f (._peek a) x)))
-  (-swap! [a f x y]
-    (-reset! a (f (._peek a) x y)))
-  (-swap! [a f x y more]
-    (-reset! a (apply f (._peek a) x y more)))
+  (-swap! [a f]          (-reset! a (f (._peek a))))
+  (-swap! [a f x]        (-reset! a (f (._peek a) x)))
+  (-swap! [a f x y]      (-reset! a (f (._peek a) x y)))
+  (-swap! [a f x y more] (-reset! a (apply f (._peek a) x y more)))

   IPrintWithWriter
-  (-pr-writer [a writer opts]
-    (-write writer (str "#<Cursor: " path " "))
-    (pr-writer (._peek a) writer opts)
-    (-write writer ">"))
+  (-pr-writer [a w opts] (pr-atom a w opts (str "Cursor: " path)))

   IWatchable
-  (-notify-watches [this oldval newval]
-    (doseq [[key f] watches]
-      (f key this oldval newval)))
-  (-add-watch [this key f]
-    (set! watches (assoc watches key f)))
-  (-remove-watch [this key]
-    (set! watches (dissoc watches key)))
+  (-notify-watches [this old new]
+    (reduce-kv (fn [_ k f] (f k this old new) nil)
+               nil watches))
+  (-add-watch [this key f]  (add-w this key f))
+  (-remove-watch [this key] (remove-w this key))

   IHash
-  (-hash [this] (hash [ratom path])))
+  (-hash [_] (hash [ratom path])))

 (defn cursor
   [src path]
@@ -315,18 +304,12 @@
   IReactiveAtom

   IWatchable
-  (-notify-watches [this oldval newval]
-    (reduce-kv (fn [_ key f]
-                 (f key this oldval newval)
-                 nil)
-               nil watches)
-    nil)
-
-  (-add-watch [_ key f]
-    (set! watches (check-watches watches (assoc watches key f))))
-
+  (-notify-watches [this old new]
+    (reduce-kv (fn [_ k f] (f k this old new) nil)
+               nil watches))
+  (-add-watch [this key f] (add-w this key f))
   (-remove-watch [this key]
-    (set! watches (check-watches watches (dissoc watches key)))
+    (remove-w this key)
     (when (and (empty? watches)
                (nil? auto-run))
       (dispose! this)))
@@ -341,14 +324,10 @@
       newval))

   ISwap
-  (-swap! [a f]
-    (-reset! a (f (-peek-at a))))
-  (-swap! [a f x]
-    (-reset! a (f (-peek-at a) x)))
-  (-swap! [a f x y]
-    (-reset! a (f (-peek-at a) x y)))
-  (-swap! [a f x y more]
-    (-reset! a (apply f (-peek-at a) x y more)))
+  (-swap! [a f]          (-reset! a (f (-peek-at a))))
+  (-swap! [a f x]        (-reset! a (f (-peek-at a) x)))
+  (-swap! [a f x y]      (-reset! a (f (-peek-at a) x y)))
+  (-swap! [a f x y more] (-reset! a (apply f (-peek-at a) x y more)))

   IComputedImpl
   (-peek-at [this]
@@ -421,8 +400,8 @@
         (set! state res)
         ;; Use = to determine equality from reactions, since
         ;; they are likely to produce new data structures.
-        (when (and (some? watches)
-                   (not= oldstate res))
+        (when-not (or (nil? watches)
+                      (= oldstate res))
           (-notify-watches this oldstate res)))
       res))

@@ -436,8 +415,8 @@
           (let [oldstate state
                 newstate (f)]
             (set! state newstate)
-            (when (and (some? watches)
-                       (not= oldstate newstate))
+            (when-not (or (nil? watches)
+                          (= oldstate newstate))
               (-notify-watches this oldstate newstate)))))
       (do
         (notify-deref-watcher! this)
@@ -454,7 +433,7 @@
       (set! state nil)
       (set! auto-run nil)
       (set! dirtyness dirty)
-      (when (some? on-dispose)
+      (when-not (nil? on-dispose)
         (on-dispose s)))
     nil)

@@ -462,10 +441,7 @@
   (-equiv [o other] (identical? o other))

   IPrintWithWriter
-  (-pr-writer [this writer opts]
-    (-write writer (str "#<Reaction " (hash this) ": "))
-    (pr-writer state writer opts)
-    (-write writer ">"))
+  (-pr-writer [a w opts] (pr-atom a w opts (str "Reaction " (hash a) ":")))

   IHash
   (-hash [this] (reaction-key this)))
@@ -487,7 +463,7 @@

 (defn flush! []
   (let [q dirty-queue]
-    (when (some? q)
+    (when-not (nil? q)
       (set! dirty-queue nil)
       (dotimes [i (alength q)]
         (let [r (aget q i)]
@@ -548,14 +524,10 @@
       newval))

   ISwap
-  (-swap! [a f]
-    (-reset! a (f state)))
-  (-swap! [a f x]
-    (-reset! a (f state x)))
-  (-swap! [a f x y]
-    (-reset! a (f state x y)))
-  (-swap! [a f x y more]
-    (-reset! a (apply f state x y more)))
+  (-swap! [a f]          (-reset! a (f state)))
+  (-swap! [a f x]        (-reset! a (f state x)))
+  (-swap! [a f x y]      (-reset! a (f state x y)))
+  (-swap! [a f x y more] (-reset! a (apply f state x y more)))

   IEquiv
   (-equiv [_ other]
@@ -568,21 +540,14 @@
                (= callback (.-callback other))))

   IWatchable
-  (-notify-watches [this oldval newval]
-    (reduce-kv (fn [_ key f]
-                 (f key this oldval newval)
-                 nil)
+  (-notify-watches [this old new]
+    (reduce-kv (fn [_ k f] (f k this old new) nil)
                nil watches))
-  (-add-watch [this key f]
-    (set! watches (assoc watches key f)))
-  (-remove-watch [this key]
-    (set! watches (dissoc watches key)))
+  (-add-watch [this key f]  (add-w this key f))
+  (-remove-watch [this key] (remove-w this key))

   IPrintWithWriter
-  (-pr-writer [_ writer opts]
-    (-write writer "#<wrap: ")
-    (pr-writer state writer opts)
-    (-write writer ">")))
+  (-pr-writer [a w opts] (pr-atom a w opts "Wrap:")))

 (defn make-wrapper [value callback-fn args]
   (Wrapper. value


fixed a vote ordering bug hopefully

fixed a vote ordering bug hopefully

--- src/mafia_votecount/models.clj
+++ src/mafia_votecount/models.clj
@@ -103,4 +103,5 @@
 (defn get-votes [id]
   (select vote
           (fields :id :index :day :voter :target)
-          (where {:game id})))
+          (where {:game id})
+          (order :id :ASC)))


Increase lein repl timeout to two minutes.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -10,7 +10,7 @@
                   [lein-deps-tree "0.1.1"]
                   ;[lein-autodoc "0.9.0"]
                   [lein-marginalia "0.7.1"]]
-        :repl-options {:timeout 60000}
+        :repl-options {:timeout 120000}
         :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
                                             'print-cause-trace)
                            new (ns-resolve (doto 'clj-stacktrace.repl require)


reset analyzer data when recompiling files

otherwise removed defs would remain and not warn properly
when accessed.

fixes #258

--- src/main/shadow/build/data.clj
+++ src/main/shadow/build/data.clj
@@ -194,12 +194,14 @@
         )))

 (defn remove-source-by-id [state resource-id]
-  (let [{:keys [virtual] :as rc} (get-in state [:sources resource-id])]
+  (let [{:keys [virtual ns] :as rc} (get-in state [:sources resource-id])]
     (if-not rc
       state
       (-> state
           (update :output dissoc resource-id)
           (update :immediate-deps dissoc resource-id)
+          ;; remove analyzer data so removed vars don't stick around
+          (update-in [:compiler-env :cljs.analyzer/namespaces] dissoc ns)
           ;; virtual resources are modified by code
           ;; and can't be affected by filesystem changes
           ;; so they never need to be removed, just their output


guard against ns* use as it is not supported

might support it at some point but I'm really not a fan.

--- src/main/shadow/cljs/build.clj
+++ src/main/shadow/cljs/build.clj
@@ -643,7 +643,10 @@

 (defn post-analyze [{:keys [op] :as ast} opts]
   (case op
-    :ns (post-analyze-ns ast opts)
+    :ns
+    (post-analyze-ns ast opts)
+    :ns*
+    (throw (ex-info "ns* not supported (require, require-macros, import, import-macros, ... must be part of your ns form)" ast))
     ast))

 (defn hijacked-parse-ns [env form name opts]


Use memoize to Cache the last 100 generated UML diagrams

Amazing.

--- src/server/handler.clj
+++ src/server/handler.clj
@@ -2,7 +2,8 @@
   (:import [java.io ByteArrayOutputStream]
            [net.sourceforge.plantuml
             FileFormat FileFormatOption SourceStringReader])
-  (:require [clojure.data.codec.base64 :as base64]
+  (:require [clojure.core.memoize :as memoize]
+            [clojure.data.codec.base64 :as base64]
             [cognitect.transit :as transit]
             [compojure.core :refer [defroutes GET OPTIONS POST]]
             [compojure.route :as route]
@@ -44,9 +45,12 @@
       (.generateImage reader stream format)
       (String. (.toByteArray stream)))))

+(def generate-uml-svg-cached
+  (memoize/lu generate-uml-svg :lu/threshold 100))
+
 (defn handle-uml [encoded]
   (let [uml (String. (base64/decode (.getBytes encoded)))
-        svg (generate-uml-svg uml)]
+        svg (generate-uml-svg-cached uml)]
     (-> (response svg)
         (content-type "image/svg+xml"))))


add type hits to remove reflection and speed up metrics recording

--- src/prometheus/core.clj
+++ src/prometheus/core.clj
@@ -3,12 +3,12 @@
     (clojure.lang IObj)
     (java.io StringWriter)
     (io.prometheus.client.exporter.common TextFormat)
-    (io.prometheus.client Counter Histogram CollectorRegistry)))
+    (io.prometheus.client Counter Histogram Counter$Child Histogram$Child CollectorRegistry)))

 ; more useful set of buckets for microservice APIs than the defaults provided by the Histogram class
 (def histogram-buckets (atom [0.001, 0.005, 0.010, 0.020, 0.050, 0.100, 0.200, 0.300, 0.500, 0.750, 1, 5]))

-(defn- make-request-counter [app-name registry]
+(defn- ^Counter make-request-counter [app-name registry]
   (-> (Counter/build)
       (.namespace app-name)
       (.name "http_requests_total")
@@ -16,23 +16,25 @@
       (.help "A counter of the total number of HTTP requests processed.")
       (.register registry)))

-(defn- make-request-histogram [app-name registry]
+(defn- ^Histogram make-request-histogram [app-name registry]
   (-> (Histogram/build)
+      (.buckets (double-array @histogram-buckets))
       (.namespace app-name)
       (.name "http_request_latency_seconds")
       (.labelNames (into-array String ["method" "status" "path"]))
       (.help "A histogram of the response latency for HTTP requests in seconds.")
-      (.buckets (double-array @histogram-buckets))
       (.register registry)))
+
+(defn- ^Counter$Child counter-with-labels [^Counter counter label-array] (.labels counter label-array))
+
+(defn- ^Histogram$Child histogram-with-labels [^Histogram histogram label-array] (.labels histogram label-array))

 (defn- record-request-metric [counter histogram request-method response-status request-time response-path]
   (let [method-label (.toUpperCase (name request-method))
         status-label (str (int (/ response-status 100)) "XX")
         labels (into-array String [method-label status-label response-path])]
-    (-> (.labels counter labels)
-        (.inc))
-    (-> (.labels histogram labels)
-        (.observe request-time))))
+    (-> (histogram-with-labels histogram labels) (.observe request-time))
+    (-> (counter-with-labels counter labels) (.inc))))

 (defn with-path
   "Adds the matched compojure route as the :path response metadata attribute"


:flow/from :all :flow/to tasks validation case

--- src/onyx/static/validation.clj
+++ src/onyx/static/validation.clj
@@ -181,7 +181,10 @@

       (when-not (or (= :all to)
                     (= :none to)
-                    (every? (fn [t] ((task->egress-edges from) t)) to))
+                    (and (= from :all)
+                         (empty? (remove all-tasks to)))
+                    (and (coll? to)
+                         (every? (fn [t] ((task->egress-edges from) t)) to)))
         (throw (ex-info ":flow/to value doesn't name a valid connected task in the workflow, :all, or :none"
                         {:entry entry}))))))


add state finalizer to include valid? flag instead of returning nil, and close delims when needed

--- src/parinfer/format/infer.cljc
+++ src/parinfer/format/infer.cljc
@@ -297,30 +297,30 @@
                    cache-postline-state)]
      state)))

+(defn finalize-state
+  [{:keys [stack] :as state}]
+  (let [valid? (not (in-str? stack)) ;; invalid if unclosed string
+        close-delims? (and valid? (seq stack))]
+    (cond-> (assoc state :valid? valid?)
+      close-delims? close-delims)))
+
 (defn process-text
-  "Update the state by processing the given text."
-  ([text] (process-text initial-state text))
-  ([state text]
-   (let [state (merge initial-state state)
+  "Fully process the given text and return the state."
+  ([text] (process-text nil text))
+  ([overrides text]
+   (let [state (merge initial-state overrides)
          lines (get-lines text)
-         state (reduce process-line state lines)
-         stack (:stack state)]
-
-     ;; VERY IMPORTANT!!!!
-     ;; Return nil if there is an unclosed string, meaning we must cancel
-     ;; processing the text.  If we don't this, the simple act of typing two
-     ;; quotes in succession could silently delete delimiters in subsequent
-     ;; strings.
-     (when-not (in-str? stack)
-       (cond-> state (seq stack) close-delims)))))
+         state (reduce process-line state lines)]
+     (finalize-state state))))

 (defn format-text
-  "Format the given text by repositioning any trailing closing delimiters based on indentation."
-  ([text] (format-text initial-state text))
-  ([state text]
-   (if-let [state (process-text state text)]
-     (join "\n" (:lines state))
-     text)))
+  "Fully process the given text and return the new text if formatting was successful."
+  ([text] (format-text nil text))
+  ([overrides text]
+   (let [state (process-text overrides text)]
+     (if (:valid? state)
+       (join "\n" (:lines state))
+       text))))

 ;;----------------------------------------------------------------------
 ;; faster processing for incremental changes
@@ -402,16 +402,12 @@
         [start-line-no end-line-no] (if (number? line-no) [line-no (inc line-no)] line-no)
         line-replacements (if (string? new-line) [new-line] new-line)

-        ;; create initial state for starting at first changed line
+        ;; 1. create initial state for starting at first changed line
+        ;; 2. process changed lines
+        ;; 3. process unchanged lines that come after
         state (initial-cached-state prev-state overrides start-line-no)
-
-        ;; process changed lines
         state (reduce process-line state line-replacements)
-
-        ;; process unchanged lines that come after
-        state (process-unchanged-lines prev-state state end-line-no)
-        stack (:stack state)]
-
-    (when-not (in-str? stack)
-      (cond-> state (seq stack) close-delims))))
-
+        state (process-unchanged-lines prev-state state end-line-no)]
+
+   (finalize-state state)))
+


Fix unbalanced let

Fix unbalanced let

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -100,8 +100,8 @@
                       (if header-name
                         (let [description (or
                                             (-> arg-sym meta :description)
-                                            (get (:default-header-descriptions swagger-options) header-name))
-                              (update-in so params-key conj (parameter-object header-name :header false description))])
+                                            (get (:default-header-descriptions swagger-options) header-name))]
+                          (update-in so params-key conj (parameter-object header-name :header false description)))
                         so)))]
     (reduce reducer swagger-object (-> routing-entry :meta :arglists first))))


core/memoize is very slow, so use our own instead

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -22,6 +22,16 @@

 ;;; Common utilities

+(defn memoize-1 [f]
+  (let [mem (atom {})]
+    (fn [arg]
+      (let [v (get @mem arg)]
+        (if-not (nil? v)
+          v
+          (let [ret (f arg)]
+            (swap! mem assoc arg ret)
+            ret))))))
+
 (defn hiccup-tag? [x]
   (or (keyword? x)
       (symbol? x)
@@ -52,8 +62,8 @@

 ;;; Props conversion

-(def cached-prop-name (memoize undash-prop-name))
-(def cached-style-name (memoize util/dash-to-camel))
+(def cached-prop-name (memoize-1 undash-prop-name))
+(def cached-style-name (memoize-1 util/dash-to-camel))

 (defn convert-prop-value [val]
   (if (map? val)
@@ -61,15 +71,17 @@
                  (doto res
                    (aset (cached-prop-name k)
                          (to-js-val v))))
-               (js-obj) val)
+               #js {} val)
     (to-js-val val)))

 (defn set-id-class [props [id class]]
-  (aset props "id" (or (aget props "id") id))
-  (when class
-    (aset props "className" (if-let [old (aget props "className")]
-                              (str class " " old)
-                              class))))
+  (let [pid (aget props "id")]
+    (aset props "id" (if-not (nil? pid) pid id))
+    (when-not (nil? class)
+      (aset props "className" (let [old (aget props "className")]
+                                (if-not (nil? old)
+                                  (str class " " old)
+                                  class))))))

 (defn convert-props [props id-class]
   (cond
@@ -129,7 +141,7 @@
 (defn wrapped-render [this comp id-class input-setup]
   (let [inprops (util/js-props this)
         argv (aget inprops cljs-argv)
-        props (get argv 1)
+        props (nth argv 1 nil)
         hasprops (or (nil? props) (map? props))
         first-child (if hasprops 2 1)
         children (if (> (count argv) first-child)
@@ -185,7 +197,7 @@
   (let [[comp id-class] (parse-tag tag)]
     (wrap-component comp id-class (str tag))))

-(def cached-wrapper (memoize get-wrapper))
+(def cached-wrapper (memoize-1 get-wrapper))

 (defn fn-to-class [f]
   (let [spec (meta f)
@@ -211,14 +223,14 @@

 (defn vec-to-comp [v level]
   (assert (pos? (count v)) "Hiccup form should not be empty")
-  (assert (valid-tag? (v 0))
+  (assert (valid-tag? (nth v 0))
           (str "Invalid Hiccup form: " (pr-str v)))
-  (let [c (as-class (v 0))
+  (let [c (as-class (nth v 0))
         jsprops (js-obj cljs-argv v
                         cljs-level level)]
     (let [k (-> v meta get-key)
           k' (if (nil? k)
-               (-> v (get 1) get-key)
+               (-> v (nth 1 nil) get-key)
                k)]
       (when-not (nil? k')
         (aset jsprops "key" k')))


Handle bare versions in ver-parse.

Handle bare versions in ver-parse.

--- src/leiningen/git_version.clj
+++ src/leiningen/git_version.clj
@@ -28,12 +28,13 @@
     (str "-" (formatted-timestamp fmt ctime) "-" sha)))

 (defn ver-parse
-  "Parses jar-path-like-string or versioned-artifact-string to find ctime and sha.
+  "Parses jar-path-like-string or artifact-version-string to find ctime and sha.
    Can handle cases in the range of:
+     1.2.3-20120219223112-abc123f
      foo-1.2.3-20120219223112-abc123f
      /path/to/foo-1.2.3-20120219223112-abc123f19ea8d29b13.jar"
   [ver-str]
-  (let [[_ ctime sha] (re-matches #".*-([0-9]{14})-([a-f0-9]{5,40})(?:\.jar)?$" ver-str)]
+  (let [[_ ctime sha] (re-matches #".*-?([0-9]{14})-([a-f0-9]{5,40})(?:\.jar)?$" ver-str)]
     (when (and ctime sha)
       {:ctime ctime :sha sha})))


update to 1.8.0 by default

update to 1.8.0 by default

--- src/leiningen/new/tenzing.clj
+++ src/leiningen/new/tenzing.clj
@@ -181,7 +181,7 @@
       (main/exit))))

 (defn render-boot-properties []
-  (let [{:keys [exit out err]} (sh/sh "boot" "-V" :env {:BOOT_CLOJURE_VERSION "1.7.0"})]
+  (let [{:keys [exit out err]} (sh/sh "boot" "-V" :env {:BOOT_CLOJURE_VERSION "1.8.0"})]
     (if (pos? exit)
       (println "WARNING: unable to produce boot.properties file.")
       out)))


added block parsing

added block parsing

--- src/selmer/template_parser.clj
+++ src/selmer/template_parser.clj
@@ -10,8 +10,8 @@
 (defn handle-extends [template templates path]
   (preprocess-template path (update-in templates [template :extends] conj path)))

-(defn handle-block [template templates path]
-  templates)
+(defn handle-block [template templates block-name]
+  (update-in templates [template :blocks] conj block-name))

 (defn get-template-path [[^String path]]
   (when path


Start with a random question, always

Start with a random question, always

--- src/sinusoides/views/main.cljs
+++ src/sinusoides/views/main.cljs
@@ -35,8 +35,8 @@
                                  [" you " "are"]
                                  [" they " "are"]])]

-               parts (r/atom ;; (vec (map apply gens))
-                      ["What " " you" [" I " "am"]])
+               parts (r/atom ;; ["What " " you" [" I " "am"]]
+                      (vec (map apply gens)))

                update-parts
                (fn [parts]


Update backend

Update backend

--- src/warehouse/core.clj
+++ src/warehouse/core.clj
@@ -15,6 +15,7 @@
 (s/defschema ProviderDescription {:type s/Str
                                   :homepage s/Str
                                   :icon s/Str
+                                  :action s/Str
                                   :params [{:name s/Str
                                             :type s/Str
                                             :secret s/Bool}]})
@@ -37,6 +38,12 @@
 (s/defschema Request {:username s/Str
                       :password s/Str
                       :url s/Str})
+
+; testing handler
+;(defn- ges-handler- [request]
+  ;(let [params (:params request)]
+    ;[{:name (:username params)
+      ;:amount 1}]))

 (defn- ges-handler- [request]
   (try
@@ -67,7 +74,8 @@
 (def ges-description {:type "ges"
                       :homepage "http://www.ges.cz"
                       :icon "http://www.ges.cz/favicon.ico"
-                      :params [{:name "user"
+                      :action "http://localhost:3000/handler/ges"
+                      :params [{:name "username"
                                 :type "string"
                                 :secret false}
                                {:name "password"


handle empty q param in count function

handle empty q param in count function

--- src/wb_es/web/core.clj
+++ src/wb_es/web/core.clj
@@ -82,12 +82,14 @@

 (defn count [q options]
-  (let [query {:query
-               {:bool
-                {:must [{:bool {:filter (get-filter options)}}
-                        {:bool {:should [{:term {:wbid q}}
-                                         {:match {:label q}}
-                                         {:match {:_all q}}]}}]}}}
+  (let [query (if (and q (not= (clojure.string/trim q) ""))
+                {:query
+                 {:bool
+                  {:must [{:bool {:filter (get-filter options)}}
+                          {:bool {:should [{:term {:wbid q}}
+                                           {:match {:label q}}
+                                           {:match {:_all q}}]}}]}}}
+                {:query {:bool {:filter (get-filter options)}}})

         response
         (http/get (format "%s/%s/_count"


Add incise plugin to user profile.

Add incise plugin to user profile.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -7,6 +7,7 @@
                        [slamhound "1.5.0"]]
         :plugins [[lein-difftest "1.3.7"]
                   [lein-exec "0.3.0"]
+                  [lein-incise "0.1.0-SNAPSHOT"]
                   [org.bodil/lein-noderepl "0.1.10"]
                   [quickie "0.2.1"]
                   [lein-kibit "0.0.8"]


in (generate-question-and-correct-set), use a source language's :semantic-correspondence, if any, to remove selected parts of target expression's semantics so that a corresponding source expression can be found in the expression table

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -97,16 +97,22 @@
                                 @((-> models :la))
                                 @((-> models :en)))
           true
-          (let [;; normalize for JSON lookup: convert a spec which is simply :top to be {}.
-                json-input-spec (if (= :top target-spec)
-                                  {}
-                                  target-spec)
-
-                target-json-spec (json/write-str (strip-refs json-input-spec))
-                ]
-            (log/debug (str "looking for expressions in language: " target-language
+          (let [;; normalize for JSON lookup:
+                json-input-spec
+                (-> target-spec
+
+                    ;; convert a spec which is simply :top to be {}:
+                    ((fn [target-spec]
+                       (if (= :top target-spec)
+                         {}
+                         target-spec)))
+
+                    ;; remove dag_unify-specific metadata:
+                    (dissoc-paths [[:dag_unify.core/serialized]]))
+                target-json-spec (json/write-str (strip-refs json-input-spec))]
+            (log/debug (str "looking for expressions in target language: " target-language
                             " with spec: " target-spec))
-            (log/debug (str "looking for expressions in language: " target-language
+            (log/debug (str "looking for expressions in target language: " target-language
                             " with json-spec: " target-json-spec))

             ;; get the structure of a random expression in the target language that matches
@@ -161,11 +167,25 @@
                         ;; TODO: allow queries that have refs - might be
                         ;; useful for modeling anaphora and binding.
                         target-semantics (get-in result [:synsem :sem])
-                        source-semantics (dissoc-paths result [[:synsem :sem :subj :null]])
-                        json-semantics (json/write-str (strip-refs (get-in result [:synsem :sem])))]
-                    (log/debug (str "target semantics:" (strip-refs target-semantics)))
+                        source-language-keyword (keyword source-language)
+                        target-language-keyword (keyword target-language)
+                        log (log/debug (str "removing paths from semantics for source language '"
+                                            source-language "':"
+                                            (-> @((models source-language-keyword))
+                                                :semantic-correspondence
+                                                target-language-keyword)))
+                        source-semantics (-> result
+                                             (get-in [:synsem :sem])
+                                             (dissoc-paths (-> @((models source-language-keyword))
+                                                               :semantic-correspondence
+                                                               target-language-keyword))
+                                             strip-refs)
+                        json-target-semantics (json/write-str (strip-refs (get-in result [:synsem :sem])))
+                        json-source-semantics (json/write-str (strip-refs source-semantics))]
+                    (log/debug (str "target semantics:" (strip-refs (get-in result target-semantics)))
                     (log/debug (str "source semantics:" (strip-refs source-semantics)))
-                    (log/trace (str "json-semantics:" json-semantics))
+                    (log/debug (str "json target semantics:" json-target-semantics))
+                    (log/debug (str "json source:" json-source-semantics))
                     (let [results
                           (db/exec-raw [(str "SELECT source.surface AS source, source.id AS source_id,
                                              target.surface AS target,target.root AS target_root,
@@ -178,30 +198,28 @@
                                                WHERE source.language=?
                                                  AND source.active=true
                                                  AND source.structure->'synsem'->'sem' @> '"
-                                             json-semantics "' LIMIT 1) AS source
+                                             json-source-semantics "' LIMIT 1) AS source
                                   INNER JOIN (SELECT DISTINCT surface, target.structure->'synsem'->'sem' AS sem,
                                                               root,structure
                                                          FROM expression_with_root AS target
                                                         WHERE target.language=?
                                                           AND target.active=true
-                                                          AND target.structure->'synsem'->'sem' = '" json-semantics "') AS target
+                                                          AND target.structure->'synsem'->'sem' = '" json-target-semantics "') AS target
                                                            ON (source.surface IS NOT NULL)
-                                                          AND (target.surface IS NOT NULL)
-                                                          AND (source.sem @> target.sem)")
+                                                          AND (target.surface IS NOT NULL)
+                                                          AND (true)")
                                         [source-language target-language]]
                                        :results)]
                       (if (nil? (first (map :source results)))
-                        (do
-                          (log/error (str "no source expression found for semantics: "
-                                          (get-in (strip-refs (deserialize
+                        (let [sql (str "SELECT surface FROM expression_with_root AS source WHERE "
+                                       " source.structure->'synsem'->'sem' @> '" json-source-semantics "'")
+                              message (str "no source expression found for target semantics: "
+                                           (get-in (strip-refs (deserialize
                                                                (read-string (:target target-expression))))
-                                                  [:synsem :sem])))
-                          (throw (Exception.
-                                  (str "no source expression found for target expression: '"
-                                       (:surface target-expression) "' and semantics: "
-                                       (get-in (strip-refs (deserialize
-                                                            (read-string (:target target-expression))))
-                                               [:synsem :sem])))))
+                                                   [:synsem :sem])
+                                           "; used source semantics:" source-semantics "; SQL:" sql)]
+                          (log/error message)
+                          (throw (Exception. message))))
                         (let [debug (log/trace (str "source-structure:"
                                                     (first (map :structure results))))
                               debug (log/trace (str "read from target_structure:"


remove filtering rules on [:cat :verb]

remove filtering rules on [:cat :verb]

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -146,10 +146,7 @@
         target-expression
         (target-timing-fn
          (binding [babel.generate/truncate? true
-                   babel.generate/grammar
-                   (filter
-                    #(= (u/get-in % [:synsem :cat]) :verb)
-                    (:grammar target-model))]
+                   babel.generate/println? true]
            (babel.generate/generate target-spec target-model)))
         source-spec
         (u/strip-refs ;; TODO: consider removing strip-refs; not clear if there is any reason why we need to do it.
@@ -162,11 +159,7 @@
         source-model @@(get models source-language)
         source-expression
         (source-timing-fn
-         (binding [babel.generate/truncate? true
-                   babel.generate/grammar
-                   (filter
-                    #(= (u/get-in % [:synsem :cat]) :verb)
-                    (:grammar source-model))]
+         (binding [babel.generate/truncate? true]
            (generate source-spec source-model)))]
     (let [pairing
           {:target ((:morph target-model) target-expression)


s/info/debug/

s/info/debug/

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -335,7 +335,7 @@
                          AND language=?"
                        [json-spec language]]
                       :results)))]
-    (log/info (str "current-count for json-spec: " json-spec "=" current-count))
+    (log/debug (str "current-count for json-spec: " json-spec "=" current-count))
     (let [count (- count current-count)]
       (if (> current-count 0)
         (log/debug (str "There are already " current-count " expressions for: " spec)))


Fix wrong usage of now not existent with-atomic macro.

--- src/suricatta/async.clj
+++ src/suricatta/async.clj
@@ -53,7 +53,7 @@
            opts (dissoc opts :chan)]
        (send-off act (fn [counter]
                        (try
-                         (sc/with-atomic ctx
+                         (sc/atomic ctx
                            (with-open [cursor (sc/fetch-lazy ctx q opts)]
                              (reduce (fn [acc v]
                                        (if-not (put! c (exc/success v))


fix search urls

fix search urls

--- src/name_bazaar/ui/utils.cljs
+++ src/name_bazaar/ui/utils.cljs
@@ -51,21 +51,21 @@
                      :routes constants/routes}))

 (def offerings-newest-url (path-with-query (path-for :route.offerings/search)
-                                           (url/map->query {:order-by-columns [(name :created-on)]
-                                                            :order-by-dirs [(name :desc)]})))
+                                           {:order-by-columns [(name :created-on)]
+                                            :order-by-dirs [(name :desc)]}))

 (def offerings-most-active-url (path-with-query (path-for :route.offerings/search)
-                                                (url/map->query {:order-by-columns [(name :bid-count)]
-                                                                 :order-by-dirs [(name :desc)]})))
+                                                {:order-by-columns [(name :bid-count)]
+                                                 :order-by-dirs [(name :desc)]}))

 (def offerings-ending-soon-url (path-with-query (path-for :route.offerings/search)
-                                                (url/map->query {:order-by-columns [(name :end-time)]
-                                                                 :order-by-dirs [(name :asc)]})))
+                                                {:order-by-columns [(name :end-time)]
+                                                 :order-by-dirs [(name :asc)]}))

 (def offerings-sold-url (path-with-query (path-for :route.offerings/search)
-                                         (url/map->query {:sold? true
-                                                          :order-by-columns [(name :finalized-on)]
-                                                          :order-by-dirs [(name :desc)]})))
+                                         {:sold? true
+                                          :order-by-columns [(name :finalized-on)]
+                                          :order-by-dirs [(name :desc)]}))

 (defn etherscan-ens-url [name]
   (gstring/format "https://etherscan.io/enslookup?q=%s" name))


Wip: next-tasks.

Wip: next-tasks.

--- src/onyx/coordinator/impl.clj
+++ src/onyx/coordinator/impl.clj
@@ -174,8 +174,21 @@
          (drop (inc (.indexOf job-seq last-offered)))
          (take (count job-seq)))))

+(defn sort-tasks-by-phase [sync tasks]
+  (sort-by :task/phase (map (fn [t] (extensions/read-place sync t)) tasks)))
+
+(defn find-active-task-ids [sync sorted-tasks]
+  (filter (fn [task] (not (task-complete? sync task))) sorted-tasks))
+
+(defn next-incomplete-task [sync job-id]
+  (let [incomplete-tasks (extensions/bucket-at sync :task job-id)
+        sorted-tasks (sort-tasks-by-phase sync incomplete-tasks)
+        active-tasks (find-active-task-ids sync sorted-tasks)]
+    (filter (fn [t] (not (contains? active-tasks (:id t)))) sorted-tasks)))
+
 (defmethod extensions/next-tasks ZooKeeper
   [sync]
   (let [job-seq (job-candidate-seq (incomplete-jobs-ids sync)
-                                   (last-offered-job sync))]))
+                                   (last-offered-job sync))
+        incomplete-candidates (mapcat (partial next-incomplete-task sync) job-seq)]))


print verbose statements from a specific fn which also now can detect whether you'd like to add indents

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -12,6 +12,16 @@

 (def ^{:dynamic true} *verbose-overtone-file-helpers* false)

+(defn print-if-verbose
+  "Prints the arguments if *verbose-overtone-file-helpers* is bound to true. If
+  it is also bound to an integer, will print a corresponding number of spaces at
+  the start of each line to indent the output."
+  [& to-print]
+  (when *verbose-overtone-file-helpers*
+    (when (integer? *verbose-overtone-file-helpers*)
+      (dotimes [_ *verbose-overtone-file-helpers*] (print " ")))
+    (apply println to-print)))
+
 (defn pretty-file-size
   "Takes number of bytes and returns a prettied string with an appropriate unit:
   b, kb or mb."
@@ -191,7 +201,7 @@
                                         (< (:val slice) max))
                                slice))
                            slices)]
-      (println (str (:perc slice) "% (" (pretty-file-size num-copied-bytes)  ") completed")))))
+      (print-if-verbose (str (:perc slice) "% (" (pretty-file-size num-copied-bytes)  ") completed")))))

 (defn- remote-file-copy [in-stream out-stream file-size]
   "Similar to  the corresponding implementation of #'do-copy in 'clojure.java.io
@@ -202,13 +212,11 @@
         slices   (percentage-slices file-size 100)]
     (loop [bytes-copied 0]
       (let [size (.read in-stream buffer)]
-        (when *verbose-overtone-file-helpers*
-          (print-file-copy-status bytes-copied size file-size slices))
+        (print-file-copy-status bytes-copied size file-size slices)
         (when (pos? size)
           (do (.write out-stream buffer 0 size)
               (recur (+ size bytes-copied))))))
-    (when *verbose-overtone-file-helpers*
-      (println "Download successful"))))
+    (print-if-verbose "Download successful")))

 (defn- download-file-without-timeout
   "Downloads remote file at url to local file specified by target path. Has
@@ -362,16 +370,14 @@
          (catch Exception e
            (rm-rf! path)
            (Thread/sleep wait-t)
-           (when *verbose-overtone-file-helpers*
-             (println (str "Download timed out. Retry " (inc attempts-made) ": " url )))
+           (print-if-verbose (str "Download timed out. Retry " (inc attempts-made) ": " url ))
            (download-file* url path timeout n-retries wait-t (inc attempts-made)))))))

 (defn- print-download-file
   [url]
-  (when *verbose-overtone-file-helpers*
-    (let [size   (remote-file-size url)
-          p-size (pretty-file-size size)]
-      (println (str "Downloading file (" p-size ") - "  url)))))
+  (let [size   (remote-file-size url)
+        p-size (pretty-file-size size)]
+    (print-if-verbose (str "Downloading file (" p-size ") - "  url))))

 (defn download-file
   "Downloads the file pointed to by url to local path. If no timeout


Reduced default instance size for prod to m1.small as it's the cheapest usable one.

--- src/tyranitar/store.clj
+++ src/tyranitar/store.clj
@@ -27,7 +27,7 @@
   [app-name env]
   {:app-name app-name
    :env-name env
-   :instance-type "m1.medium"
+   :instance-type "m1.small"
    :graphite-host "graphite.int.ent.nokia.com"
    :is-prod true
    :ssh-security-group "AppGate"


Added a comment explaining the drawbacks of new*.

--- src/appengine_magic/services/datastore.clj
+++ src/appengine_magic/services/datastore.clj
@@ -420,6 +420,30 @@
   (save! [this] (save-many-helper! this)))

+;;; TODO: new* is a mistake. Its current implementation prevents property-values
+;;; from being evaluated and used if the argument is a variable, or the result
+;;; of a function call. Unfortunately, undoing this is not easy. The following
+;;; implementation, though it superficially works, is both dangerous (because it
+;;; uses eval), and does not pass tests.
+;;
+;; (defmacro new* [entity-record-type property-values & {:keys [parent]}]
+;;   `(let [property-values# ~property-values
+;;          entity# (cond (map? property-values#) (record ~entity-record-type property-values#)
+;;                   (vector? property-values#) (eval `(new ~~entity-record-type ~@property-values#)))
+;;          parent# ~parent]
+;;      (if (nil? parent#)
+;;          entity#
+;;          (with-meta entity# {:key (get-key-object entity# parent#)
+;;                              :parent (get-key-object parent#)}))))
+;;
+;;; The key difficulty is in vectors stored in variables which contain the
+;;; record's slot values in order. Dealing with the vector value would require
+;;; the equivalent of (apply new ~entity-record-type ~property-values), but
+;;; apply cannot be used on macros or special forms.
+;;;
+;;; The correct solution to this problem is to deprecate new* and encourage
+;;; anyone who needs entity group creation to use an alternative function which
+;;; populates the :parent metadata correctly.
 (defmacro new* [entity-record-type property-values & {:keys [parent]}]
   (let [props-expr (cond (vector? property-values) `(new ~entity-record-type ~@property-values)
                          (map? property-values) `(record ~entity-record-type ~property-values)


Added check for mkvtoolnix installation

Added check for mkvtoolnix installation

--- src/video_server/encoder.clj
+++ src/video_server/encoder.clj
@@ -126,17 +126,23 @@
   (doseq [subtitle (:subtitles video)]
     (encode-subtitle (io/file (:file folder) (:filename subtitle)))))

+(def mkvtools (delay (and (-> ["which" "mkvmerge"] exec :exit zero?)
+                          (-> ["which" "mkvextract"] exec :exit zero?))))
+
 (defn mkv-info
   "Returns the mkv info by calling mkvmerge."
   [file]
-  (let [exec (exec ["mkvmerge" "-i" (.getCanonicalPath file)])]
-    (when (zero? (:exit exec))
-      (:out exec))))
+  (when @mkvtools
+    (try (let [exec (exec ["mkvmerge" "-i" (.getCanonicalPath file)])]
+           (when (zero? (:exit exec))
+             (:out exec)))
+         (catch Exception e (log/error e "error extracting info")))))

 (defn mkv-extract
   "Extracts the embedded attachment into a separate file."
   [file id output]
-  (exec ["mkvextract" "attachments" (.getCanonicalPath file) (str id ":" (.getCanonicalPath output))]))
+  (try (exec ["mkvextract" "attachments" (.getCanonicalPath file) (str id ":" (.getCanonicalPath output))])
+       (catch Exception e (log/error e "error extracting attactment"))))

 (defn extract-thumbnail
   "Extracts the thumbnail image from the matroska video."


set-path! cljs

set-path! cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -42,6 +42,8 @@
     (.split js/window.location.pathname "/")))

 (defn show-wishlist! [{:keys [wishes title] :as wishlist}]
+(defn set-path! [code]
+  (.pushState js/window.history nil "lol" code))
   (empty $content)
   (empty $header)
   (append $content (wish-ul wishes))


Doubled max points

Doubled max points

--- src/clojush/problems/control/lawnmower.clj
+++ src/clojush/problems/control/lawnmower.clj
@@ -216,8 +216,8 @@
    :crossover-probability 0.3
    :simplification-probability 0.3
    :reproduction-simplifications 10
-   :max-points 200
-   :max-points-in-initial-program 200
+   :max-points 400
+   :max-points-in-initial-program 400
    :evalpush-limit 1000
    })


Added the checksum problem.

Added the checksum problem.

--- src/clojush/problems/software/checksum.clj
+++ src/clojush/problems/software/checksum.clj
@@ -1,8 +1,185 @@
+;; checksum.clj
+;; Tom Helmuth, thelmuth@cs.umass.edu
+;;
+;; Problem Source: Program Repair Benchmark Paper (add citation later)
+;;
+;; Given a string (max length 50), compute the integer values of the characters
+;; in the string, sum them, take the sum modulo 64, add the value of the \space
+;; character, and then convert that integer back into its corresponding character
+;; (the checksum). Program must print "Check sum is X", where X is replaced by
+;; the correct checksum.
+;;
+;; input stack has the input string
+
+(ns clojush.problems.software.checksum
+  (:use clojush.pushgp.pushgp
+        [clojush pushstate interpreter random util globals]
+        clojush.instructions.tag
+        clojure.math.numeric-tower
+        ))
+
+; Atom generators
+(def checksum-atom-generators
+  (concat (list
+            "Check sum is "
+            \space
+            64
+            ;;; end constants
+            (fn [] (- (lrand-int 257) 128)) ;Integer ERC [-128,128]
+            (fn [] (lrand-nth (concat [\newline \tab] (map char (range 32 127))))) ;Visible character ERC
+            ;;; end ERCs
+            (tag-instruction-erc [:exec :integer :boolean :string :char] 1000)
+            (tagged-instruction-erc 1000)
+            ;;; end tag ERCs
+            'in1
+            ;;; end input instructions
+            )
+          (registered-for-stacks [:integer :boolean :string :char :exec :print])))

-(defn checksum [st]
-  (char (+ (mod (apply + (map int st)) 64)
-           (int \space))))
+;; Define test cases
+(defn checksum-input
+  "Makes a checksum input of length len."
+  [len]
+  (apply str
+         (repeatedly len
+                     #(lrand-nth (concat [\newline \tab]
+                                         (map char (range 32 127)))))))

-; Answer should be \V
-(checksum "?? water the plants !!")
+;; A list of data domains for the problem. Each domain is a vector containing
+;; a "set" of inputs and two integers representing how many cases from the set
+;; should be used as training and testing cases respectively. Each "set" of
+;; inputs is either a list or a function that, when called, will create a
+;; random element of the set.
+(def checksum-data-domains
+  [[(list "", "A", "\t", "\n", "B\n", "\n\n",
+          (apply str (repeat 50 \newline))
+          (apply str (repeat 50 \space))
+          (apply str (repeat 50 \s))
+          (apply str (take 50 (cycle (list \C \D \newline))))
+          (apply str (take 50 (cycle (list \x \newline \y \space))))
+          (apply str (take 50 (cycle (list \space \newline))))) 22 0] ;; "Special" inputs covering some base cases
+   [(fn [] (checksum-input (inc (lrand-int 50)))) 88 1000]
+   ])
+
+
+(defn test-and-train-data-from-domains
+  "Takes a list of domains and creates a set of (random) train inputs and a set of test
+   inputs based on the domains. Returns [train test]. A program should not
+   be considered a solution unless it is perfect on both the train and test
+   cases."
+  [domains]
+  (apply mapv concat (map (fn [[input-set n-train n-test]]
+                            (if (fn? input-set)
+                              (vector (repeatedly n-train input-set)
+                                      (repeatedly n-test input-set))
+                              (vector (if (>= n-train (count input-set))
+                                        input-set
+                                        (take n-train (shuffle input-set)))
+                                      (if (>= n-test (count input-set))
+                                        input-set
+                                        (take n-test (shuffle input-set))))))
+                          domains)))
+
+;;Can make checksum test data like this:
+;(test-and-train-data-from-domains checksum-data-domains)
+
+; Helper function for error function
+(defn checksum-test-cases
+  "Takes a sequence of inputs and gives IO test cases of the form
+   [input output]."
+  [inputs]
+  (map #(vector %
+                (format "Check sum is %c"
+                        (char (+ (mod (apply + (map int %)) 64)
+                                 (int \space)))))
+       inputs))
+
+; Define error function. For now, each run uses different random inputs
+(defn checksum-error-function
+  "Returns the error function for the checksum problem. Takes as
+   input checksum data domains."
+  [data-domains]
+  (let [[train-cases test-cases] (map checksum-test-cases
+                                      (test-and-train-data-from-domains data-domains))]
+    (when true ;; Change to false to not print test cases
+      (doseq [[i case] (map vector (range) train-cases)]
+        (println (format "Train Case: %3d | Input/Output: %s" i (str case))))
+      (doseq [[i case] (map vector (range) test-cases)]
+        (println (format "Test Case: %3d | Input/Output: %s" i (str case)))))
+    (fn the-actual-checksum-error-function
+      ([program]
+        (the-actual-checksum-error-function program :train))
+      ([program data-cases] ;; data-cases should be :train or :test
+        (the-actual-checksum-error-function program data-cases false))
+      ([program data-cases print-outputs]
+        (let [behavior (atom '())
+              errors (doall
+                       (for [[input correct-output] (case data-cases
+                                                                 :train train-cases
+                                                                 :test test-cases
+                                                                 [])]
+                         (let [final-state (run-push program
+                                                     (->> (make-push-state)
+                                                       (push-item input :input)
+                                                       (push-item "" :output)))
+                               printed-result (stack-ref :output 0 final-state)]
+                           (when print-outputs
+                             (println (format "Correct output: %-19s | Program output: %-19s" correct-output printed-result)))
+                           ; Record the behavior
+                           (when @global-print-behavioral-diversity
+                             (swap! behavior conj printed-result))
+                           ; Error is Levenshtein distance
+                           (levenshtein-distance correct-output printed-result))))]
+          (when @global-print-behavioral-diversity
+            (swap! population-behaviors conj @behavior))
+          errors)))))
+
+(defn checksum-report
+  "Custom generational report."
+  [best population generation error-function report-simplifications]
+  (let [best-program (not-lazy (:program best))
+        best-test-errors (error-function best-program :test)
+        best-total-test-error (apply +' best-test-errors)]
+    (println ";;******************************")
+    (printf ";; -*- Checksum problem report - generation %s\n" generation)(flush)
+    (println "Test total error for best:" best-total-test-error)
+    (println (format "Test mean error for best: %.5f" (double (/ best-total-test-error (count best-test-errors)))))
+    (when (zero? (:total-error best))
+      (doseq [[i error] (map vector
+                             (range)
+                             best-test-errors)]
+        (println (format "Test Case  %3d | Error: %d" i error))))
+    (println ";;------------------------------")
+    (println "Outputs of best individual on training cases:")
+    (error-function best-program :train true)
+    (println ";;******************************")
+    )) ;; To do validation, could have this function return an altered best individual
+       ;; with total-error > 0 if it had error of zero on train but not on validation
+       ;; set. Would need a third category of data cases, or a defined split of training cases.
+
+
+; Define the argmap
+(def argmap
+  {:error-function (checksum-error-function checksum-data-domains)
+   :atom-generators checksum-atom-generators
+   :max-points 800
+   :max-points-in-initial-program 400
+   :evalpush-limit 1500
+   :population-size 1000
+   :max-generations 300
+   :parent-selection :lexicase
+   :genetic-operator-probabilities {:alternation 0.2
+                                    :uniform-mutation 0.2
+                                    :uniform-close-mutation 0.1
+                                    [:alternation :uniform-mutation] 0.5
+                                    }
+   :alternation-rate 0.01
+   :alignment-deviation 10
+   :uniform-mutation-rate 0.01
+   :problem-specific-report checksum-report
+   :print-behavioral-diversity true
+   :report-simplifications 0
+   :final-report-simplifications 5000
+   ;:max-error 1
+   })


fix tests

fix tests

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -376,14 +376,14 @@
                        :sem {:pred :read
                              :subj {:pred :cat}}
                        :subcat '()}}
-        lbs (babel.generate/lightning-bolts med spec 0 0)
+        lbs (babel.generate/lightning-bolts med spec 0 6)
         good-lb (first (filter #(and (= (get-in % [:head :rule])
                                         "transitive-vp-nonphrasal-head")
                                      (= (get-in % [:head :head :english :english])
                                         "read"))
                                lbs))

-        comp-map (comp-paths-to-bolts-map good-lb med 0 0)]
+        comp-map (comp-paths-to-bolts-map good-lb med 0 6)]
     (is (some empty? (vals comp-map)))))

 (deftest rathole-check-2
@@ -392,7 +392,7 @@
                        :sem {:pred :read
                              :subj {:pred :woman}}
                        :subcat '()}}
-        lbs (babel.generate/lightning-bolts med spec 0 0)
+        lbs (babel.generate/lightning-bolts med spec 0 6)
         good-lb (first (filter #(and (= (get-in % [:head :rule])
                                         "transitive-vp-nonphrasal-head")
                                      (= (get-in % [:head :head :english :english])
@@ -584,3 +584,4 @@

     (is (not (empty? (get paths-to-lbs [:head :comp]))))
     (is (not (empty? (get paths-to-lbs [:comp]))))))
+


use engine/generate-all

use engine/generate-all

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -5,7 +5,7 @@
             [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
             [babel.italiano.morphology.nouns :as nouns]
             [babel.italiano.morphology.verbs :as verbs]
-            [babel.italiano.workbook :refer [analyze generate generate-all parse]]
+            [babel.italiano.workbook :refer [analyze generate parse]]
             [babel.parse :as parse]
             #?(:clj [clojure.test :refer [deftest is]])
             #?(:cljs [cljs.test :refer-macros [deftest is]])
@@ -14,7 +14,8 @@
             [clojure.repl :refer [doc]]
             [clojure.string :as string]
             [clojure.set :as set]
-            [dag_unify.core :refer [copy get-in strip-refs]]))
+            [dag_unify.core :refer [copy get-in strip-refs]]
+            [babel.engine :as engine]))

 (deftest analyze-1
   (let [singular (analyze "compito")
@@ -89,11 +90,11 @@
 (deftest roundtrip-np-grammar
   (let [do-this-many 100
         expressions (take do-this-many
-                           (generate-all {:synsem {:sem {:spec {:def :top}
-                                                         :mod {:pred :top}
-                                                         :number :top
-                                                         :pred :top}}}
-                                         np-grammar))]
+                          (engine/generate-all {:synsem {:sem {:spec {:def :top}
+                                                               :mod {:pred :top}
+                                                               :number :top
+                                                               :pred :top}}}
+                                               np-grammar))]
     (is (= do-this-many
            (count (pmap (fn [expr]
                           (let [fo (fo expr)
@@ -259,4 +260,16 @@
             (not (nil? (generate synsem)))))))

-
+(deftest casa-parse
+  (is (not (empty?
+            (parse "io sono a casa")))))
+
+(deftest casa-generate
+  (let [result (generate
+                {:synsem {:cat :verb
+                          :sem {:tense :present
+                                :pred :a
+                                :obj {:pred :casa}
+                                :subj {:pred :I}}}})]
+    (is (or true
+            (= (fo result) "io sono a casa")))))


add morphology test

add morphology test

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -1,15 +1,21 @@
 (ns babel.test.it
   (:refer-clojure :exclude [get-in])
   (:require [babel.engine :refer [generate]]
-            [babel.italiano.grammar :refer [small]]
+            [babel.italiano.grammar :refer [small medium]]
             [babel.italiano.lexicon :refer [lexicon]]
-            [babel.italiano.morphology :refer [fo]]
+            [babel.italiano.morphology :refer [analyze fo]]
             [babel.italiano.workbook :refer [parse]]
             #?(:clj [clojure.test :refer [deftest is]])
             #?(:cljs [cljs.test :refer-macros [deftest is]])
             #?(:clj [clojure.tools.logging :as log])
             #?(:cljs [babel.logjs :as log])
             [dag_unify.core :refer [get-in strip-refs]]))
+
+(deftest analyze-1
+  (let [singular (analyze "compito" (:lookup medium))
+        plural  (analyze "compiti" (:lookup medium))]
+    (is (not (nil? singular)))
+    (is (not (nil? plural)))))

 (deftest present-irregular
   (let [result (generate {:synsem {:subcat '()


Stop `:name` being accepted for Interceptors.  Should be `:id`.

`:name` was only ever valid for a short time during the alpha phases of 0.8.0

--- src/re_frame/interceptor.cljc
+++ src/re_frame/interceptor.cljc
@@ -15,13 +15,11 @@

 (defn ->interceptor
   "Create an interceptor from named arguments"
-  [& {:as m :keys [name id before after]}]      ;; XXX remove `name` in due course - only in there as a backwards compat thing
+  [& {:as m :keys [id before after]}]
   (when debug-enabled?
-    (if name                                    ;; XXX remove in due course
-      (console :warn  "re-frame.core/->interceptor no longer takes `:name` - has been renamed to `:id`. Please change for " name))
     (if-let [unknown-keys  (seq (clojure.set/difference
-                             (-> (dissoc m :name) keys set)         ;; XXX take out name in due course
-                             mandatory-interceptor-keys))]
+                                  (-> m keys set)
+                                  mandatory-interceptor-keys))]
       (console :error "re-frame: ->interceptor " m " has unknown keys:" unknown-keys)))
   {:id     (or id name :unnamed)     ;; XXX remove `name` in due course
    :before before


Minor change on core tests.

Minor change on core tests.

--- test/buddy/test_buddy_core.clj
+++ test/buddy/test_buddy_core.clj
@@ -33,7 +33,20 @@
     (let [mybytes (into-array Byte/TYPE (range 10))
           encoded (bytes->hex mybytes)
           decoded (hex->bytes encoded)]
-      (is (bytes/equals? decoded mybytes)))))
+      (is (bytes/equals? decoded mybytes))))
+
+  (testing "Safe base64 encode/decode"
+    (let [output1 (str->safebase64 "foo")
+          output2 (safebase64->str output1)]
+      (is (= output1 "Zm9v"))
+      (is (= output2 "foo"))))
+
+  (testing "Concat byte arrays"
+    (let [array1 (into-array Byte/TYPE [1,2,3])
+          array2 (into-array Byte/TYPE [3,4,5])]
+      (is (bytes/equals? (bytes/concat array1 array2)
+                         (into-array Byte/TYPE [1,2,3,3,4,5]))))))
+

 (deftest buddy-core-hash
   (testing "SHA3 support test"
@@ -45,17 +58,3 @@
     (let [path       "test/_files/pubkey.ecdsa.pem"
           valid-hash "7aa01e35e65701c9a9d8f71c4cbf056acddc9be17fdff06b4c7af1b0b34ddc29"]
       (is (= (bytes->hex (hash/sha256 (io/input-stream path))) valid-hash)))))
-
-(deftest buddy-core-codecs
-  (testing "Safe base64 encode/decode"
-    (let [output1 (str->safebase64 "foo")
-          output2 (safebase64->str output1)]
-      (is (= output1 "Zm9v"))
-      (is (= output2 "foo"))))
-  (testing "Concat byte arrays"
-    (let [array1 (into-array Byte/TYPE [1,2,3])
-          array2 (into-array Byte/TYPE [3,4,5])]
-      (is (bytes/equals? (bytes/concat array1 array2)
-                         (into-array Byte/TYPE [1,2,3,3,4,5]))))))
-
-


cjl - Fix problem tests

cjl - Fix problem tests


Fix / adopt the query test to the new structure

--- test/io/cyanite/query_test.clj
+++ test/io/cyanite/query_test.clj
@@ -9,27 +9,21 @@

 (deftest query-test
   (with-config
-    {:engine (component/using
-              (e/map->Engine {:rules {"default" ["5s:1h"]}})
-              [:drift
-               :queues
-               :writer])
-     :store  (s/memory-store)
-     :writer (component/using
-              (writer/map->Writer {})
-              [:index
-               :store
-               :queues])}
+    {:engine {:rules {"default" ["5s:1h"]}}}
+    {}
     (let [store     (:store *system*)
           clock     (:clock *system*)
           index     (:index *system*)
+          writer    (:writer *system*)
           engine    (:engine *system*)
           base-time 1454877020]
       (doseq [i (range 0 11)]
         (set-time! clock (* (+ base-time i) 1000))
-        (e/accept! engine {:path "a.b.c" :metric i :time (+ base-time i)})
-        (e/accept! engine {:path "a.b.d" :metric (* 100 i) :time (+ base-time i)})
-        (e/accept! engine {:path "a.b.f" :metric (* 1000 i) :time (+ base-time i)}))
+        (e/ingest! engine {:path "a.b.c" :metric i :time (+ base-time i)})
+        (e/ingest! engine {:path "a.b.d" :metric (* 100 i) :time (+ base-time i)})
+        (e/ingest! engine {:path "a.b.f" :metric (* 1000 i) :time (+ base-time i)})
+        (when (= 0 (mod i 5))
+          (e/snapshot! writer)))

       (are [query result]
           (= (run-query! store index engine base-time (+ base-time 60)