Add basic FadecandyDisplayer [untested]

Add basic FadecandyDisplayer [untested]

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -1,7 +1,8 @@
 (ns sparkle.core
   (:require [clojure.core.async :refer [thread chan <!! >!! alt!! close!]]
             [clojure.algo.generic.functor :refer [fmap]]
-            [com.stuartsierra.component :as component])
+            [com.stuartsierra.component :as component]
+            [sparkle.fadecandy-opc :as fc])
   (:gen-class))

 (defn now []
@@ -71,6 +72,23 @@
                  (not= frame prev-frame))
         (reset! previous {:frame frame :time (now)})
         (println frame)))))
+
+(defn scale-pixel [pixel]
+  (let [scale-fn (fn [value]
+                   (int (min 256 (max 0 (* 256 value)))))]
+    (fmap scale-fn pixel)))
+
+(defrecord FadecandyDisplayer []
+  component/Lifecycle
+  (start [displayer]
+    displayer)
+
+  (stop [displayer]
+    displayer)
+
+  Displayer
+  (display [displayer frame]
+    (fc/push-pixels {0 (map scale-pixel frame)})))

 (defn get-env-updates [env]


shaders are gone

shaders are gone

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -57,101 +57,9 @@

 (defonce left "←")
 (defonce right "→")
-
-
 (defonce scroll-text
   (font/make-text "100 24px Indie Flower"
                   "Old School Demo on a New School platform??! Crispin, here, paying homage to the 8-bit and 16-bit wonderboxes of our childhood. Commodore lives! A big shout out to Team Farnarkle and to the Inversion crew. Best wishes to everyone out there and enjoy the games!\n"))
-
-;;
-;; experimental shaders
-;;
-
-(defn make-test []
-  (let [f
-        (PIXI/AbstractFilter.
-         #js [
-              "
-precision mediump float;
-varying vec2 vTextureCoord;
-varying vec4 vColor;
-uniform sampler2D uSampler;
-uniform float time;
-
-// hue,saturation,value -> red,green,blue
-vec3 hsv2rgb(vec3 c)
-{
-    vec4 K = vec4(1.0, 2.0 / 3.0, 1.0 / 3.0, 3.0);
-    vec3 p = abs(fract(c.xxx + K.xyz) * 6.0 - K.www);
-    return c.z * mix(K.xxx, clamp(p - K.xxx, 0.0, 1.0), c.y);
-}
-
-// shader mainline
-void main( void ) {
-    vec4 col = texture2D(uSampler, vTextureCoord);
-
-    float r=col.r;
-    float g=col.g;
-    float b=col.b;
-
-    // is our hue magenta?
-    bool mag = ((r-b)<0.1) && r>0.1 && g<0.1;
-
-    if(mag)
-    {
-         gl_FragColor = vec4(
-             hsv2rgb(
-                 vec3(4.0 * vTextureCoord.y + (-0.02 * time),
-                      1.0,
-                      1.0)),
-             1.0) * r;
-    }
-    else
-    {
-        gl_FragColor = col;
-    }
-}
-"]
-         #js {"time" #js {"type" "1f" "value" 0.0}})]
-    (go
-      (loop [frame 0]
-        (<! (events/next-frame))
-        (set! (.-uniforms.time.value f) (float frame))
-        (recur (inc frame))))
-    f))
-
-(defn make-bounce []
-  (let [f
-        (PIXI/AbstractFilter.
-         #js [
-              "
-precision mediump float;
-varying vec2 vTextureCoord;
-varying vec4 vColor;
-uniform sampler2D uSampler;
-uniform float time;
-
-// shader mainline
-void main( void ) {
-    float x=vTextureCoord.x;
-    float y=vTextureCoord.y;
-    vec4 col = texture2D(uSampler,
-                         vec2(x,
-                              y - 0.05 * sin(0.1 * time + 10.0 * x))
-                         //vec2(x,y)
-                         );
-
-    gl_FragColor = col;
-}
-"]
-         #js {"time" #js {"type" "1f" "value" 0.0}})]
-    (go
-      (loop [frame 0]
-        (<! (events/next-frame))
-        (set! (.-uniforms.time.value f) (float frame))
-        (recur (inc frame))))
-    f))
-

 (defn main []
   (go


core: prn

core: prn

--- data/core.clj
+++ data/core.clj
@@ -1782,3 +1782,10 @@
   {:added "1.0"}
   []
   (newline*))
+
+(defn prn
+  "Same as pr followed by (newline)."
+  {:added "1.0"}
+  [& more]
+  (apply pr more)
+  (newline))


iunno I ought to decide whether this is a firm style rule for me

--- src/vigil/web/start.clj
+++ src/vigil/web/start.clj
@@ -10,6 +10,7 @@
             [ring.adapter.jetty :as jetty]
             [vigil.web.pages.index :as index]
             [vigil.web.pages.game :as game]))
+

 (defn parse-id [id]
   "Turn an ID from a parameter string into a map with an :id key to an integer,


Clean up PubSub listener thread (don't keep head!)

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -343,10 +343,10 @@
                                             :listener? true))
          in#   (conns/in-stream conn#)]

-     ;; Create a thread to actually listen for and process messages from
-     ;; server. Thread will close when connection closes.
-     (-> (bound-fn [] (@handler-atom# (protocol/get-basic-reply! in#) @state-atom#))
-         repeatedly doall future)
+     (future-call ; Thread to long-poll for messages
+      (bound-fn []
+        (while true ; Closes when conn closes
+          (@handler-atom# (protocol/get-basic-reply! in#) @state-atom#))))

      (protocol/with-context conn# ~@body)
      (Listener. conn# handler-atom# state-atom#)))


Housekeeping

Housekeeping

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -549,7 +549,10 @@
                :attrs    [:timestamp :subject]
                :consistent? true}
      :friends {:prim-kvs [{:catagory \"favorites\" :id [1 2 3]}
-                          {:catagory \"recent\"    :id [7 8 9]}]}})"
+                          {:catagory \"recent\"    :id [7 8 9]}]}})
+
+  :max-reqs allows a number of requests to automatically be stitched together
+  (to exceed throughput limits, for example)."
   [creds requests & [{:keys [return-cc? max-reqs] :as opts
                       :or   {max-reqs 5}}]]
   (letfn [(run1 [raw-req]
@@ -580,7 +583,10 @@
    (batch-write-item creds
      {:users {:put    [{:user-id 1 :username \"sally\"}
                        {:user-id 2 :username \"jane\"}]
-              :delete [{:user-id [3 4 5]}]}})"
+              :delete [{:user-id [3 4 5]}]}})
+
+  :max-reqs allows a number of requests to automatically be stitched together
+  (to exceed throughput limits, for example)."
   [creds requests & [{:keys [return-cc? max-reqs] :as opts
                       :or   {max-reqs 5}}]]
   (letfn [(run1 [raw-req]
@@ -707,7 +713,7 @@

 ;;;; Misc. helpers

-;; TODO Automatic throughput adjustment tools
+;; TODO Automatic throughput (and > 2x) adjustment tools

 (defn items-by-attrs
   "Groups one or more items by one or more attributes, returning a map of form


Explain persistent Clojure example better

--- clojure/persistent_example.clj
+++ clojure/persistent_example.clj
@@ -1,5 +1,6 @@
-(def a (list (repeat 100 :dog)))
-(def b (conj a :cat))
+(def a (list (repeat 1000 :dog)))   ; 1000-dog list
+(def b (conj a :cat))               ; new list, cat at front

 (use 'clojure.test)
 (is (identical? a (rest b)))
+(is (= (type a) clojure.lang.PersistentList))


Added wrap-stacktrace.

Added wrap-stacktrace.

--- src/vertigo/core.clj
+++ src/vertigo/core.clj
@@ -6,7 +6,7 @@
             [compojure.route :as route])
   (:use     [compojure.core]
             [clj-time.core :only (now)]
-            [ring.middleware.reload]))
+            [ring.middleware reload stacktrace]))

 (defroutes handler
   (GET "/helsinki" []
@@ -22,7 +22,9 @@
     (batch/update))
   (route/resources "/"))

-(ae/def-appengine-app vertigo-app (wrap-reload #'handler '(vertigo.core)))
+(ae/def-appengine-app vertigo-app
+  (wrap-stacktrace
+   (wrap-reload #'handler '(vertigo.core))))


Add call logging

Add call logging

--- src/zaffre/font.cljc
+++ src/zaffre/font.cljc
@@ -5,7 +5,7 @@
             [clojure.java.io :as jio]
             [taoensso.timbre :as log])
   (:import (zaffre.imageutil Image)
-           (java.io File)
+           (java.io File IOException)
            (java.net URL MalformedURLException)
            (java.nio ByteBuffer)
            (java.nio.file Files Path)
@@ -15,6 +15,15 @@

 (set! *warn-on-reflection* true)
 (set! *unchecked-math* true)
+
+(def calls (atom []))
+;(add-watch calls :persist
+;  (fn [_ _ _ calls]
+;    (spit "calls.log" calls)))
+
+
+(defn log-call [method-name & args]
+  (swap! calls (fn [calls] (conj calls {:method-name method-name :args args}))))

 (defn- byte-buffer->str [^ByteBuffer buffer]
   (if buffer
@@ -58,15 +67,19 @@
                      :linux (linux-font-paths)
                      :macosx (macosx-font-paths)
                      :window (windows-font-paths))]
-    (for [path font-paths
-          ^File file (files path)
-          :when (some (fn [extension] (.endsWith (.getAbsolutePath file)  extension))
-                      extensions)]
-      (if (Files/isSymbolicLink (.toPath file))
-        (let [^Path link (Files/readSymbolicLink file)]
-          (when (-> link .toFile .exists))
-            (Files/readSymbolicLink link))
-        (.toPath file)))))
+    (remove nil?
+      (for [path font-paths
+            ^File file (files path)
+            :when (some (fn [extension] (.endsWith (.getAbsolutePath file)  extension))
+                        extensions)]
+        (let [^Path file-path (.toPath file)]
+          (if (Files/isSymbolicLink file-path)
+            (let [^Path link (Files/readSymbolicLink file-path)]
+              (try
+                (Files/readSymbolicLink link)
+                (catch IOException e
+                  nil)))
+            (.toPath file)))))))

 (declare make-font)

@@ -76,29 +89,32 @@
           (mapcat identity
             (for [path (font-paths)]
               (try
-                (let [file        (File. (str path))
+                #_(log/info "type path" (type path))
+                (let [file        (.toFile path)
                       font-info   (make-font file)
                       font-name   (font-name font-info)
                       font-family (font-family font-info)]
                   [[font-name file]
                    [font-family file]])
                 (catch Exception e
-                  (log/error "Error loading" path e))))))))
+                  (log/error e "Error loading" path ))))))))

 (defn system-fonts []
   @system-fonts-map)

 (defn- as-font-path
   [x]
-  (try
-    (URL. x)
-    (catch MalformedURLException err
-      (let [file (File. x)]
-      (if (.exists file)
-        file
-        (get (system-fonts) x))))))
+  (if (= File (type x))
+    x
+    (try
+      (URL. x)
+      (catch MalformedURLException err
+          (let [file (File. x)]
+            (if (.exists file)
+              file
+              (get (system-fonts) x)))))))

-(defn- make-font
+(defn make-font
   [x]
   (if-let [font-path (as-font-path x)]
     ;; Load font from file
@@ -126,12 +142,18 @@

 ;; A sequence of [character underline?]
 (defn- displayable-characters [^STBTTFontinfo font]
-  (let [chars (map char
-                   (filter (fn [c]
-                             (and (pos? (STBTruetype/stbtt_FindGlyphIndex font (int c)))
-                                  (not (contains? cjk-blocks c))))
-                                (range 0x0000 0xFFFF)))]
-    chars))
+  "Returns a map from codepoint to glyph index"
+  (into {}
+    (reduce (fn [m codepoint]
+             (log-call "STBTruetype/stbtt_FindGlyphIndex" font (int codepoint))
+             (let [glyph-index (STBTruetype/stbtt_FindGlyphIndex font (int codepoint))]
+               (if  (and (pos? glyph-index)
+                         (not (contains? cjk-blocks codepoint)))
+                 (assoc m codepoint glyph-index)
+                 m)))
+          {}
+          (range 0x0000 0xFFFF))))
+

 (defn- characters-per-line [char-width num-characters]
   (int (Math/floor (/ (Math/pow 2 11) char-width))))
@@ -140,7 +162,7 @@
 (defn character-idxs
   [char-width characters]
   (let [character-matrix (partition-all (characters-per-line char-width (count characters)) characters)]
-    (log/info "arranging character with" characters-per-line "per line")
+    #_(log/info "arranging character with" characters-per-line "per line")
     (mapcat concat
     (map-indexed (fn [row line]
                    (map-indexed (fn [col c]
@@ -204,20 +226,38 @@
       compact-image)
     image))

-(defn- hmetrics [^STBTTFontinfo font-info codepoint]
-  (let [advance-width (BufferUtils/createIntBuffer 1)
+(defn- hmetrics [^STBTTFontinfo font-info glyph-index]
+  (let [advance-width     (BufferUtils/createIntBuffer 1)
         left-side-bearing (BufferUtils/createIntBuffer 1)]
-    (STBTruetype/stbtt_GetCodepointHMetrics font-info (int codepoint) advance-width left-side-bearing)
+    (log-call "STBTruetype/stbtt_GetGlyphHMetrics" font-info (int glyph-index) advance-width left-side-bearing)
+    (STBTruetype/stbtt_GetGlyphHMetrics font-info (int glyph-index) advance-width left-side-bearing)
     [(.get advance-width) (.get left-side-bearing)]))

-(defn- codepoint-bitmap-box [^STBTTFontinfo font-info scale codepoint]
+(defn- vmetrics [^STBTTFontinfo font-info]
+  (let [ascent   (BufferUtils/createIntBuffer 1)
+        descent  (BufferUtils/createIntBuffer 1)
+        line-gap (BufferUtils/createIntBuffer 1)]
+    (log-call "STBTruetype/stbtt_GetFontVMetrics" font-info ascent descent line-gap)
+    (STBTruetype/stbtt_GetFontVMetrics font-info ascent descent line-gap)
+    [(.get ascent) (.get descent) (.get line-gap)]))
+
+(defn- glyph-bitmap-box [^STBTTFontinfo font-info scale glyph-index]
   (let [ix0 (BufferUtils/createIntBuffer 1)
         iy0 (BufferUtils/createIntBuffer 1)
         ix1 (BufferUtils/createIntBuffer 1)
         iy1 (BufferUtils/createIntBuffer 1)]
-    (STBTruetype/stbtt_GetCodepointBitmapBox
+    (log-call "STBTruetype/stbtt_GetGlyphBitmapBox"
       font-info
-      (int codepoint)
+      (int glyph-index)
+      (float scale)
+      (float scale)
+      ix0
+      iy0
+      ix1
+      iy1)
+    (STBTruetype/stbtt_GetGlyphBitmapBox
+      font-info
+      (int glyph-index)
       (float scale)
       (float scale)
       ix0
@@ -227,20 +267,20 @@
     [(.get ix0) (.get iy0) (.get ix1) (.get iy1)]))

-(defn- char-image [font-info char-width char-height ascent scale codepoint]
+(defn- char-image [font-info char-width char-height ascent scale codepoint glyph-index]
   (let [;scale 0.015625
-        [x0 y0 x1 y1]         (codepoint-bitmap-box font-info scale codepoint)
-        baseline              (* ascent scale)
-        [_ left-side-bearing] (map (partial * scale) (hmetrics font-info codepoint))
+        [x0 y0 x1 y1]         (glyph-bitmap-box font-info scale glyph-index)
+        baseline              (int (* ascent scale))
+        [_ left-side-bearing] (map (partial * scale) (hmetrics font-info glyph-index))
         y                     (+ baseline y0)
         img                   (zimg/image char-width char-height 1)
         chr-img               (zimg/image char-width char-height 1)]
-    (log/info "char-width" (char codepoint) "(" (int codepoint) ")" char-width char-height
-              "ascent" ascent "scale" scale "baseline" baseline
-              "left-side-bearing" left-side-bearing "y" y)
+    ;(log/info "char-width" (char codepoint) "(" (int codepoint) ")" char-width char-height
+    ;        "ascent" ascent "scale" scale "baseline" baseline
+    ;        "left-side-bearing" left-side-bearing "y" y)
     ;(log/info "x0" x0 "y0" y0 "x1" x1 "y1" y1)
     ;; draw greyscale font
-    (STBTruetype/stbtt_MakeCodepointBitmapSubpixel
+    (log-call "STBTruetype/stbtt_MakeGlyphBitmapSubpixel"
       font-info
       (get img :byte-buffer)
       char-width
@@ -250,10 +290,21 @@
       scale
       0.0
       0.0
-      (int codepoint))
-    (zimg/draw-image chr-img img left-side-bearing (+ (int baseline) y))
-    (zimg/write-png chr-img (str "char-image/" (int codepoint) ".png"))
-    (zimg/write-png img (str "char-image/" (int codepoint) "-raw.png"))
+      (int glyph-index))
+    (STBTruetype/stbtt_MakeGlyphBitmapSubpixel
+      font-info
+      (get img :byte-buffer)
+      char-width
+      char-height
+      char-width
+      scale
+      scale
+      0.0
+      0.0
+      (int glyph-index))
+    (zimg/draw-image chr-img img left-side-bearing y)
+    ;(zimg/write-png chr-img (str "char-image/" (int codepoint) ".png"))
+    ;(zimg/write-png img (str "char-image/" (int codepoint) "-raw.png"))
     ;; convert to rgba
     (zimg/mode chr-img :rgba)))

@@ -310,20 +361,23 @@
 (defrecord TTFFont [name-or-path size transparent]
   GlyphGraphics
   (glyph-graphics [this]
-    #_{:post [(glyph-graphics? %)]}
     ;; Adjust canvas to fit character atlas size
     (let [^STBTTFontinfo font-info   (make-font name-or-path)
           scale                      (STBTruetype/stbtt_ScaleForPixelHeight
                                        font-info
                                        size)
           [advance
-           left-side-bearing]        (map (partial * scale) (hmetrics font-info (int \M)))
+           left-side-bearing]        (map (partial * scale)
+                                       (hmetrics font-info
+                                                 (STBTruetype/stbtt_FindGlyphIndex
+                                                   font-info
+                                                   (int \M))))
           characters                 (displayable-characters font-info)
           char-width                 (int (Math/ceil advance))
           char-height                size
-          ascent                     (BufferUtils/createIntBuffer 1)
-          descent                    (BufferUtils/createIntBuffer 1)
-          line-gap                   (BufferUtils/createIntBuffer 1)
+          [ascent
+           descent
+           line-gap]                 (vmetrics font-info)
           _ (log/info "characters per line" (characters-per-line char-width (count characters)))
           cwidth     2048
           cheight    (zutil/next-pow-2 (* char-height (int (Math/ceil (/ (count characters)
@@ -332,24 +386,20 @@
           height     cheight ;(max cwidth cheight)
           antialias  true
           char-idxs   (character-idxs char-width characters)]
-      (STBTruetype/stbtt_GetFontVMetrics font-info ascent descent line-gap)
-      (log/info "characters" (count characters) "cwidth" cwidth "cheight" cheight)
-      (log/info "glyph image width" width "height" height)
-      (log/info "char-idxs" char-idxs)
+      (log/info characters)
+      #_(log/info "characters" (count characters) "cwidth" cwidth "cheight" cheight)
+      #_(log/info "glyph image width" width "height" height)
+      #_(log/info "char-idxs" char-idxs)
       ;(log/info "characters" (vec characters))
       ;(log/info "character-idxs" (vec (character-idxs characters)))
-      (let [texture-image (zimg/image width height)
-            ascent        (.get ascent)]
+      (let [texture-image (zimg/image width height)]
         ;; Loop through each character, drawing it
-        (doseq [[c col row]  (reverse char-idxs)]
+        (doseq [[[codepoint glyph-index] col row]  (reverse char-idxs)]
           (try
             (let [x  (* col char-width)
                   y  (* row char-height)
-                  chr-img (char-image font-info char-width char-height ascent scale c)
-                    #_#_[x0 y0 x1 y1] (codepoint-bitmap-box font-info scale (int c))
-                    #_#_cy (int (+ y baseline y0))]
-              (log/info "thread" (-> (Thread/currentThread) .getName))
-              (log/info "drawing" c "@" x y)
+                  chr-img (char-image font-info char-width char-height ascent scale codepoint glyph-index)]
+              #_(log/info "drawing" codepoint "@" x y)
               (zimg/draw-image texture-image
                              chr-img
                              x
@@ -357,7 +407,7 @@
               (catch Throwable t
                 (log/error t))))
         ;; cleanup texture resource
-        #_(zimg/write-png texture-image "glyph-texture.png")
+        (zimg/write-png texture-image "glyph-texture.png")
         {:font-texture-width width
          :font-texture-height height
          :font-texture-image texture-image


Add `invadm list` with basic filtering

Add `invadm list` with basic filtering

--- src/invadm/core.clj
+++ src/invadm/core.clj
@@ -19,6 +19,9 @@
         ""
         "  invadm create -c CURRENCY -r CLIENT -a AMOUNT [-f FILENAME] ID"
         "    Creates an invoice."
+        ""
+        "  invadm list {-c CURRENCY, -r CLIENT, -f FILENAME}"
+        "    Lists invoices."
         ""
         "  invadm data"
         "    Dump all the data in a JSON array."]
@@ -61,8 +64,18 @@
 (defn get-invoice-filenames []
   (filter is-json? (map get-io-file-name (file-seq (io/file (cwd))))))

+(defn read-all-invoices []
+  (map read-json (get-invoice-filenames)))
+
 (defn data []
-  (println (json/write-str (map read-json (get-invoice-filenames)))))
+  (println (json/write-str (read-all-invoices))))
+
+(defn options-to-filter [options]
+  (fn [invoice]
+    (every? (fn[key_](= (get options key_) (get invoice (name key_)))) (keys options))))
+
+(defn list_ [options]
+  (println (json/write-str (filter (options-to-filter options) (read-all-invoices)))))

 (defn -main [& args]
   (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
@@ -74,4 +87,5 @@
     (case (first arguments)
       "create" (create options arguments)
       "data" (data)
+      "list" (list_ options)
       (exit 1 (usage summary)))))


Minor revision to query

Minor revision to query

Change in triple order

--- resources/rules/_1_post_identifier_merge/step_h_ice_to_bio/step_hc_ggp_abstractions/step_hcb_assign_taxon/uniprot/uniprot_protein_assign_taxon.clj
+++ resources/rules/_1_post_identifier_merge/step_h_ice_to_bio/step_hc_ggp_abstractions/step_hcb_assign_taxon/uniprot/uniprot_protein_assign_taxon.clj
@@ -28,6 +28,13 @@
     ?primary_accession_field_value rdf:type ccp:IAO_EXT_0000240 . # ccp:UniProt_protein_record__primary_accession_field_value
     ?primary_accession_field_value rdf:type ?uniprot_id .
          ?uniprot_id obo:IAO_0000219 ?bioentity . # IAO:denotes
+
+         # ignore any bioentities that already have a taxon restriction
+           minus {
+                  ?bioentity rdfs:subClassOf ?taxon_r .
+                           ?taxon_r owl:onProperty ?only_in_taxon .
+                                    }
+
     ?record obo:BFO_0000051 ?organism_record . # BFO:has_part
     ?organism_record rdf:type ccp:IAO_EXT_0000935 . # ccp:UniProt_protein_record__organism_field_value
     ?organism_record rdf:type ccp:IAO_EXT_0000972 . # ccp:uniprot_organism_record
@@ -41,13 +48,6 @@
     # ensure it's a kabob bioentity (not an obo bioentity)
          filter (contains (str(?taxon), 'http://ccp.ucdenver.edu/kabob/bio/'))

-         # ignore any bioentities that already have a taxon restriction
-  minus {
-         ?bioentity rdfs:subClassOf ?taxon_r .
-         ?taxon_r owl:onProperty ?only_in_taxon .
-         }
-
-
   }"


More clean up.

More clean up.

--- src/tic_tac_toe/core.clj
+++ src/tic_tac_toe/core.clj
@@ -14,21 +14,21 @@

 (def blank-board
-  [\- \- \-
-   \- \- \-
-   \- \- \-])
+  [:e :e :e
+   :e :e :e
+   :e :e :e])

 (def board (atom blank-board))

 (def test-board1
-  [\- \- \-
-   \- \o \-
-   \- \- \-])
+  [:e :e :e
+   :e :o :e
+   :e :e :e])

 (def board-x-wins
-  [\x \- \o
-   \- \x \o
-   \- \- \x])
+  [:x :e :o
+   :e :x :o
+   :e :e :x])

 (def board-o-wins
   [:x :e :o
@@ -36,9 +36,9 @@
    :e :e :o])

 (def board-draw
-  [\x \o \o
-   \o \x \x
-   \x \o \o])
+  [:x :o :o
+   :o :x :x
+   :x :o :o])

 (def poses (range 9))

@@ -89,15 +89,16 @@
   (some (fn [partition] (every? #(= player %) partition)) partitions))

 (defn winner
-  "Return one of x, o, nil, :draw"
+  "Return one of :x, :o, nil, :draw"
   ([board]
      (let [partitions (winning-partitions board)]
        (cond
-        (player-has-won \x partitions) \x
-        (player-has-won \o partitions) \o
+        (player-has-won :x partitions) :x
+        (player-has-won :o partitions) :o
         (empty? (available-squares board)) :draw
         :else nil))))

+;(winner blank-board)

 ;;0 1 2


tidy up reference.cljc

tidy up reference.cljc

--- src/twigs/reference.cljc
+++ src/twigs/reference.cljc
@@ -42,17 +42,17 @@
   Object
   (toString [_] (.toString ref))

+  IPersistentStack
+  (peek [_] (-> ref .getKey keyword))
+  (pop [_] (TwigRef. (.getParent ref)))
+
   IPersistentCollection
   (cons [_ c] (TwigRef. (.child ref (name c))))
   (empty [_] (TwigRef. (.getRoot ref)))
   (equiv [_ other]
     (if (instance? TwigRef other)
       (= (str ref) (str other))
-      false))
-
-  IPersistentStack
-  (peek [_] (-> ref .getKey keyword))
-  (pop [_] (TwigRef. (.getParent ref)))))
+      false))))

 (defn wrap-reference
   "construct a twig reference from a url."


Improve simulation

Improve simulation

--- src/tobias/core.clj
+++ src/tobias/core.clj
@@ -28,22 +28,22 @@
       :matches matching-features
       :score (count matching-features))))

-(defn get-scored-ads [current-ad->features resulting-features]
+(defn get-scored-ads [ads resulting-features]
   "Given a map of resulting features, computes the score for each ad feature"
   (let [result-set (set resulting-features)] ; convert to set for easy operation
     (map #(score-feature-set (set %) result-set)
-         current-ad->features)))
+         ads)))

-(defn get-winning-ad [current-features resulting-features]
-  (let [results (get-scored-ads current-features resulting-features)]
+(defn get-winning-ad [ads resulting-features]
+  (let [results (get-scored-ads ads resulting-features)]
     (->> results
          (group-by :score)
          (sort)
-         (last)
-         (second)
-         (rand-nth)
-         (assoc {} :winner)
-         (merge {:features resulting-features}))))
+         (last)                                             ; get the highest-scored maps
+         (second)                                           ; discard score
+         (rand-nth)                                         ; a random one from the group
+         (assoc {} :winner)                                 ; make that the winner
+         (merge {:features resulting-features}))))          ; also include the image's features

 (def ads (load-config (clojure.java.io/resource "ads.edn")))

@@ -57,18 +57,19 @@
 (defn map-values [m f]
   (reduce (fn [m' [k v]] (assoc m' k (f v))) {} m))

-(defn run-simulation []
-  (let [winner-ad (rand-nth ads)]
-    {:winner winner-ad
-     :features (->> (map-values features rand-nth)
-                    (merge (select-keys winner-ad [:age :gender])))})) ; merge with winner's age/gender
+(defn random-features []
+  (map-values features rand-nth))
+
+(defn run-simulation [env-features]
+  (let [simulated-result (merge env-features (random-features))]
+    (get-winning-ad ads simulated-result)))

 (defroutes app-routes
   (GET "/" [] (content-type (resource-response "index.html" {:root "public"}) "text/html"))
   (POST "/auction/new"
         {{{image :tempfile} :file} :params} (response (run-auction image {:location :prime :weather :sunny})))
   (POST "/simulation/new"
-        {{{image :tempfile} :file} :params} (response (run-simulation)))
+        {{{image :tempfile} :file} :params} (response (run-simulation {:location :prime :weather :sunny})))
   (route/resources "/")
   (route/not-found "Not Found"))


Tweak some primitive colors.

Tweak some primitive colors.

--- src/vault/print.clj
+++ src/vault/print.clj
@@ -85,8 +85,8 @@

 (color-primitive nil :bold :black)
-(color-primitive java.lang.Boolean :cyan)
-(color-primitive java.lang.Number :green)
+(color-primitive java.lang.Boolean :green)
+(color-primitive java.lang.Number :cyan)
 (color-primitive java.lang.Character :bold :magenta)
 (color-primitive java.lang.String :bold :magenta)
 (color-primitive clojure.lang.Keyword :bold :yellow)
@@ -153,8 +153,10 @@

 (defmethod canonize :default
   [value]
-  [:span "<" (color-text (.getName (class value)) :green)
-   (str \space (pr-str value) \>)])
+  [:span (color-text "#<" :blue)
+   (color-text (.getName (class value)) :bold :blue)
+   " " (str value)
+   (color-text ">" :blue)])

 (defprinter cprint canonize {:width 80})


Atomic typos page: correct form should be displayed

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -273,6 +273,8 @@
                 (if search-results
                     [:table {:class "table table-stripped table-hover" :style "width:auto"}
                         [:tr [:th "Word"]
+                             (if (= mode :atomic-typos)
+                                 [:th "Correct form(s)"])
                              [:th "Added at"]
                              [:th "Added by"]
                              (if (= mode :blacklist)
@@ -283,6 +285,8 @@
                             (let [deleted (= (:deleted search-result) 1)
                                   word    (:word search-result)]
                                 [:tr [:td word]
+                                     (if (= mode :atomic-typos)
+                                         [:td (:correct search-result)])
                                      [:td (:datetime search-result)]
                                      [:td (user-href (:user search-result) mode)]
                                      (if (= mode :blacklist)


Tabs for whitelist and blacklist

Tabs for whitelist and blacklist

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -125,10 +125,10 @@
     "Render error page with a 'back' button."
     [word user-name message url-prefix]
     (page/xhtml
-        (render-html-header "" url-prefix nil) ; TODO change
-        [:body
-            [:div {:class "container"}
-                (render-navigation-bar-section user-name url-prefix nil); TODO change
+        (render-html-header "" url-prefix nil) ; TODO change, it might not work correctly (title, mode)
+        [:body
+            [:div {:class "container"}
+                (render-navigation-bar-section user-name url-prefix nil); TODO change, it might not work correctly (title, mode)
                 [:div {:class "col-md-10"}
                     [:h2 "Sorry, error occured in zg"]
                     [:p message]
@@ -141,6 +141,7 @@
     ))

 (defn render-front-page
+    "Render front page of this application."
     [word user-name search-results message url-prefix title mode]
     (page/xhtml
         (render-html-header word url-prefix title)
@@ -159,9 +160,9 @@
                             [:div {:class "navbar-header"}
                                 [:a {:href (str url-prefix "deleted-words-in-whitelist") :class "navbar-brand"} "Deleted words"]
                             ] ; ./navbar-header
-                        [:div {:style "width:80%"}
-                            (render-search-field word url-prefix)
-                        ]
+                            [:div {:style "width:80%"}
+                                (render-search-field word url-prefix mode)
+                            ]
                         ]
                         [:br]
                         [:br]
@@ -175,6 +176,7 @@
                                 (form/submit-button {:class "btn btn-danger"} "Add new words")
                                 [:br]
                             )
+                                [:br]
                     ]
                 [:div {:class "container-fluid"}
                         [:div {:class "row"}
@@ -187,9 +189,9 @@
                             [:div {:class "navbar-header"}
                                 [:a {:href (str url-prefix "deleted-words-in-blacklist") :class "navbar-brand"} "Deleted words"]
                             ] ; ./navbar-header
-                        [:div {:style "width:80%"}
-                            (render-search-field word url-prefix)
-                        ]
+                            [:div {:style "width:80%"}
+                                (render-search-field word url-prefix mode)
+                            ]
                         ]
                         [:br]
                         [:br]
@@ -215,7 +217,7 @@
                         [:tr [:th "Word"]
                              [:th "Added at"]
                              [:th "Added by"]
-                             (if true
+                             (if (= mode :blacklist)
                                  [:th "Description"])
                              [:th "Status"]
                              [:th "Operation"]]
@@ -224,8 +226,8 @@
                                   word    (:word search-result)]
                                 [:tr [:td word]
                                      [:td (:datetime search-result)]
-                                     [:td (:user search-result)]
-                                     (if true
+                                     [:td (user-href (:user search-result) mode)]
+                                     (if (= mode :blacklist)
                                          [:td (:description search-result)])
                                      [:td (if deleted "deleted" "active")]
                                      [:td (if deleted [:a {:href (str "?undelete=" word) :class "btn btn-success"} "undelete"]
@@ -238,6 +240,7 @@
     ))

 (defn render-users
+    "Render page containing list of all users."
     [user-name statistic changes url-prefix title mode]
     (page/xhtml
         (render-html-header nil url-prefix title)


Fix build

Fix build

--- src_ext/depends.ocp.boot
+++ src_ext/depends.ocp.boot
@@ -171,11 +171,3 @@
    ]

 end
-
-begin library "uri"
-  files = [
-    "ocaml-uri/lib/uri_re.ml"
-    "ocaml-uri/lib/uri.ml"
-  ]
-  requires = [ "re" ]
-end


Add convenient override for default set-prep!

--- lib.app.dev/src/dev_extras.clj
+++ lib.app.dev/src/dev_extras.clj
@@ -61,6 +61,10 @@

 (integrant.repl/set-prep! #(system/system-config {:profile :dev}))

+(defn set-prep!
+  [aero-opts]
+  (integrant.repl/set-prep! #(system/system-config aero-opts)))
+
 (defn test-all []
   (run-all-tests #"edge.*test$"))


Updated when_test to be more correct.

Updated when_test to be more correct.

Some of the tests were written expecting wrong behavior, so I corrected
those. Also, they were comparing on the strings of the trees, not the
trees itself (turning the tree into a string loses data) so changed them
to compare on the trees.

--- formatter/test/formatter/Extensions/when_test.clj
+++ formatter/test/formatter/Extensions/when_test.clj
@@ -11,8 +11,7 @@
 "(if pred
   (do
     (foo)
-    (bar))
-       )")
+    (bar)))")
 (def t0-out
 "(when pred
     (foo)
@@ -51,13 +50,14 @@

 (when pred
     (foo)
-    (bar))")
+    (bar)
+       )")
 (def map-2 {:in (par/parser t2-in :unhide :content)
             :out (par/parser t2-out :unhide :content)})
 (deftest test-pre-whitespace
   (testing "Tests that it maintains whitespace before the statement"
-    (is (= (par/htree-to-str (do-modification(:in map-2)))
-           (par/htree-to-str (:out map-2))))))
+    (is (= (do-modification(:in map-2))
+           (:out map-2)))))

 (def t3-in
 "(if (= 3
@@ -72,13 +72,14 @@
         :a
         19)
  (foo)
-   (bar))")
+   (bar)
+       )")
 (def map-3 {:in (par/parser t3-in :unhide :content)
             :out (par/parser t3-out :unhide :content)})
 (deftest test-more-spacing
   (testing "Tests that it keeps parameters on different lines (doesn't indent)"
-    (is (= (par/htree-to-str (do-modification(:in map-3)))
-           (par/htree-to-str (:out map-3))))))
+    (is (= (do-modification(:in map-3))
+           (:out map-3)))))

 (def t4-in "(if p (do :a :b))")
 (def t4-out "(when p :a :b)")
@@ -86,5 +87,5 @@
             :out (par/parser t4-out :unhide :content)})
 (deftest test-symbol-spacing
   (testing "Tests that it doesn't eat spaces in the do loop if it's on a single line"
-    (is (= (par/htree-to-str (do-modification(:in map-4)))
-           (par/htree-to-str (:out map-4))))))+    (is (= (do-modification(:in map-4))
+           (:out map-4)))))


fix center plot conditional

fix center plot conditional

--- src/clj/collect_earth_online/generators/clj_point.clj
+++ src/clj/collect_earth_online/generators/clj_point.clj
@@ -117,9 +117,7 @@
                               sample-distribution
                               samples-per-plot
                               sample-resolution]
-  (let [center?          (or (= "center" sample-distribution)
-                             (>= sample-resolution plot-size))
-        circle?          (= plot-shape "circle")
+  (let [circle?          (= plot-shape "circle")
         radius           (/ plot-size 2.0)
         buffer           (/ radius 25.0)
         samples-per-plot (case sample-distribution
@@ -147,7 +145,7 @@
                                 :visible_id  (+ idx visible-offset)
                                 :sample_geom (tc/str->pg (make-wkt-point sample-lon sample-lat) "geometry")})
                              (cond
-                               center?
+                               (= "center" sample-distribution)
                                [[lon lat]]

                                (= "gridded" sample-distribution)


Update ack-process docstring

Update ack-process docstring

--- src/com/farmlogs/conduit/subscription/ack_process.clj
+++ src/com/farmlogs/conduit/subscription/ack_process.clj
@@ -22,15 +22,15 @@
                          (not (:redelivery? msg))))))

 (defn ack-process
-  "Given a channel, start the message acknowledgement process. Return
-  a channel that closes when the ack process terminates. The
-  acknowledgement process can be shut down by closing
-  new-messages-chan. Once all pending messages have finished the
-  process will stop.
+  "Given a core.async channel and an RMQ channel, start the message
+  acknowledgement process. Return a channel that closes when the ack
+  process terminates. The acknowledgement process can be shut down by
+  closing new-messages-chan. Once all pending messages have finished
+  the process will stop.

    - new-messages-chan :: a core.async channel that conveys new
-                          messages into the ack process. Data on the
-                          ack channel is of the form
+                          messages into the ack process. Data on
+                          this channel is of the form
                           [result-chan msg-headers]."
   [new-messages-chan rmq-channel]
   (a/go-loop [pending {new-messages-chan ::nothing}]


Add sample.

Add sample.

--- test/dsbdp/test/local_dpp_self_adaptivity_tests.clj
+++ test/dsbdp/test/local_dpp_self_adaptivity_tests.clj
@@ -14,10 +14,17 @@
     [clojure.test :refer :all]
     [dsbdp.local-dpp-self-adaptivity :refer :all]))

-(def four-staged-pipeline-stats-example
+(def four-staged-pipeline-stats-example-1
   {3 {:out 17460, :dropped 1082},
    2 {:out 18542, :dropped 1697469},
    1 {:out 1716523, :dropped 611647},
    0 {:out 2328170, :dropped 2911553},
    :pipeline {:in 5239723, :dropped 7764598}})

+(def four-staged-pipeline-stats-example-2
+  {3 {:out 18460, :dropped 2082},
+   2 {:out 19542, :dropped 1698469},
+   1 {:out 1717523, :dropped 612647},
+   0 {:out 2329170, :dropped 2912553},
+   :pipeline {:in 5240723, :dropped 7765598}})
+


simplify distance calculation even more.

--- clojure/point-mutations/dna.clj
+++ clojure/point-mutations/dna.clj
@@ -2,10 +2,4 @@

 (defn hamming-distance
   [s1 s2]
-  (loop [[hd1 & tl1] s1
-         [hd2 & tl2] s2
-         acc-dist (atom 0)]
-    (if-not (= hd1 hd2) (swap! acc-dist inc))
-    (if (some empty? [tl1 tl2])
-      @acc-dist
-      (recur tl1 tl2 acc-dist))))
+  (count (filter identity (map not= s1 s2))))


core.clj; annotations wip

core.clj; annotations wip

--- clojure/src/dataloader/core.clj
+++ clojure/src/dataloader/core.clj
@@ -54,8 +54,8 @@
   "Printlns x to stdout."
   (. (. System out) println x))

-(defn download-ns [url fname]
-  "Downloads a BEL namespace (.belns) URL and saves it to fname."
+(defn download-url [url fname]
+  "Download a URL and save it to fname."
   (->> (slurp url) (spit fname)))

 (defn namespace-urls [idx]
@@ -63,9 +63,52 @@
   (def ret [])
   (doseq [x (xml-seq (parse idx))
     :when (= :idx:namespace (:tag x))]
-      (doseq [y (:attrs x)]
-        (def ret (conj ret (y 1)))))
+    (doseq [y (:attrs x)]
+      (def ret (conj ret (y 1)))))
   (lazy-seq ret))
+
+(defn anno-urls [idx]
+  "Get BEL annotation (.belanno) URLs from the resource index idx."
+  (def ret[])
+  (doseq [x (xml-seq (parse idx))
+    :when (= :idx:annotationdefinition (:tag x))]
+    (doseq [y (:attrs x)]
+      (def ret (conj ret (y 1)))))
+  (lazy-seq ret))
+
+(defn parse-annotation [annofile]
+  "Get a map representation of a BEL annotation (.belanno)."
+  (def annomap {})
+  (def values[])
+  (with-open [rdr (reader annofile)]
+    (def val-block false)
+    ; for keyword, type, description, and usage
+    (def ad-block false)
+
+  ;   (doseq [line (line-seq rdr)]
+  ;     (if (true? val-block)
+  ;       (do
+  ;         (def tokens (split line #"\|"))
+  ;         (def value [(tokens 0) (tokens 1)])
+  ;         (def values (conj values value))))
+  ;     (if (true? ns-block)
+  ;       (do
+  ;         (def tokens (split line #"="))
+  ;         (if (= "Keyword" (tokens 0))
+  ;           (def nsmap (merge nsmap {:keyword (tokens 1)})))
+  ;         (if (= "NameString" (tokens 0))
+  ;           (def nsmap (merge nsmap {:name (tokens 1)})))
+  ;         (if (= "DescriptionString" (tokens 0))
+  ;           (def nsmap (merge nsmap {:description (tokens 1)})))))
+  ;     (if (re-matches #"\[.*\]" line)
+  ;       (do
+  ;         (def ns-block false)
+  ;         (def val-block false)
+  ;         (if (= line "[Values]")
+  ;           (def val-block true))
+  ;         (if (= line "[Namespace]")
+  ;           (def ns-block true))))))
+  ; (merge nsmap {:values values}))

 (defn parse-namespace [nsfile]
   "Get a map representation of a BEL namespace (.belns)."
@@ -127,21 +170,26 @@
   (mg/set-db! (mg/get-db db))
   (outln "okay")
   (out "Dropping collections... ")
-  (coll/drop "namespaces")
-  (coll/drop "nsvalues")
+  ; (coll/drop "namespaces")
+  ; (coll/drop "nsvalues")
   (outln "okay")
-  (doseq [x (namespace-urls residx)]
+  ; (doseq [x (namespace-urls residx)]
+  ;   (out (str x "... "))
+  ;   (download-url x "temp.belns")
+  ;   (def nsmap (parse-namespace "temp.belns"))
+  ;   (def nsmeta-id (ObjectId.))
+  ;   (def nsmeta-doc (assoc (dissoc nsmap :values) :_id nsmeta-id))
+  ;   (coll/insert "namespaces" nsmeta-doc)
+  ;   (doseq [value (nsmap :values)]
+  ;     (def nsval-id (ObjectId.))
+  ;     (def nsval-meta {:_id nsval-id :nsmeta-id nsmeta-id})
+  ;     (def nsval-norm (clojure.string/lower-case (value 0)))
+  ;     (def nsval-data {:enc (value 1) :val (value 0) :norm nsval-norm})
+  ;     (coll/insert "nsvalues" (conj nsval-meta nsval-data)))
+  ;   (outln "okay"))
+  (doseq [x (anno-urls residx)]
     (out (str x "... "))
-    (download-ns x "temp.belns")
-    (def nsmap (parse-namespace "temp.belns"))
-    (def nsmeta-id (ObjectId.))
-    (def nsmeta-doc (assoc (dissoc nsmap :values) :_id nsmeta-id))
-    (coll/insert "namespaces" nsmeta-doc)
-    (doseq [value (nsmap :values)]
-      (def nsval-id (ObjectId.))
-      (def nsval-meta {:_id nsval-id :nsmeta-id nsmeta-id})
-      (def nsval-norm (clojure.string/lower-case (value 0)))
-      (def nsval-data {:enc (value 1) :val (value 0) :norm nsval-norm})
-      (coll/insert "nsvalues" (conj nsval-meta nsval-data)))
+    (download-url x "temp.belanno")
+    (def annomap (parse-annotation "temp.belanno"))
     (outln "okay"))
   (mg/disconnect!))


Fix path format for `fake.class.path` on Windows

The `fake.class.path` env variable is currently populated in a way that
leaves an extraneous leading forward slash character at the start of all
path components on Windows, so that:

  "C:\\Program Files\\Java\\jdk1.8.0_77\\jre\\lib\\ext\\access-bridge-64.jar"

Ends up being represented as:

  "/C:/Program Files/Java/jdk1.8.0_77/jre/lib/ext/access-bridge-64.jar"

This patch uses `java.nio.file.Paths` to properly convert each component
of the classpath to a valid system-specific path before using it to
populate the `fake.class.path` variable.

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -21,7 +21,7 @@
   (:import
     [boot App]
     [java.io File]
-    [java.nio.file Path]
+    [java.nio.file Path Paths]
     [java.net URLClassLoader URL]
     [java.lang.management ManagementFactory]
     [java.util.concurrent LinkedBlockingQueue TimeUnit Semaphore ExecutionException]))
@@ -165,7 +165,8 @@
                                    ((juxt :source-paths :resource-paths))
                                    (apply concat)
                                    (map #(.getAbsolutePath (io/file %))))
-              paths           (->> (pod/get-classpath) (map #(.getPath (URL. %))))
+              paths           (->> (pod/get-classpath)
+                                   (map #(.getPath (.toFile (Paths/get (.toURI (URL. %)))))))
               dir?            (comp (memfn isDirectory) io/file)
               fake-paths      (->> paths (remove dir?) (concat user-dirs))
               separated       (partial string/join (System/getProperty "path.separator"))


More fileset API changes, fixed deprecate! macro

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -21,7 +21,7 @@
     [java.lang.management ManagementFactory]
     [java.util.concurrent LinkedBlockingQueue TimeUnit Semaphore]))

-(declare watch-dirs sync! post-env! get-env set-env! tmpfile tmp-dir ls)
+(declare watch-dirs sync! post-env! get-env set-env! tmp-file tmp-dir ls)

 (declare ^{:dynamic true :doc "The running version of boot app."}        *app-version*)
 (declare ^{:dynamic true :doc "The script's name (when run as script)."} *boot-script*)
@@ -54,7 +54,7 @@
   (let [dirs        (:dirs this)
         has-mask?   #(= %1 (select-keys %2 (keys %1)))
         filter-keys #(->> %1 (filter (partial has-mask? %2)))]
-    (->> masks+ (map masks) (apply merge) (filter-keys dirs) (map tmpfile) set)))
+    (->> masks+ (map masks) (apply merge) (filter-keys dirs) (map tmp-file) set)))

 (defn- get-add-dir [this masks+]
   (let [user?  (contains? masks+ :user)
@@ -270,10 +270,10 @@

 ;; Tempdir and Fileset API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defmacro- deprecate! [was is & [args]]
-  `(defn ^:deprecated ~was
+(defmacro ^:private deprecate! [was is]
+  `(defn ^:deprecated ~was [& args#]
      (util/warn "%s was deprecated, please use %s instead\n" '~was '~is)
-     (~is ~@args)))
+     (apply ~is args#)))

 (defn tmp-dir!
   "Creates a boot-managed temporary directory, returning a java.io.File."


warn when the version of required dependencies change

I've ran into an issue today. My project has a dependency on
ring/ring-devel "1.3.1", which itself depends on
org.clojure/tools.namespace "0.2.4"

When I start a development repl, I add the org.clojure/tools.namespace
"0.2.9" dependency. boot didn't warn me about that and silently used the
old version of tools.namespace (which of course had a bug).

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -175,10 +175,34 @@
   (#'clojure.core/load-data-readers)
   (set! *data-readers* (.getRawRoot #'*data-readers*)))

+(defn- find-version-conflicts
+  "compute a seq of [name new-coord old-coord] elements describing version conflicts
+   when resolving the 'old' dependency vector and the 'new' dependency vector"
+  [old new env]
+  (let [resolve-deps (fn [deps] (->> deps
+                                     rm-clojure-dep
+                                     (assoc env :dependencies)
+                                     pod/resolve-dependencies
+                                     (map (juxt (comp first :dep) (comp second :dep)))
+                                     (into {})))
+        old-deps (resolve-deps old)
+        new-deps (resolve-deps new)]
+    (->> new-deps
+         (map (fn [[name coord]] [name coord (get old-deps name coord)]))
+         (remove (fn [[name new-coord old-coord]] (= new-coord old-coord))))))
+
+(defn- report-version-conflicts
+  "Warn, when the version of a dependency changes. Call this with the
+  result of find-version-conflicts as arguments"
+  [coll]
+  (doseq [[name new-coord old-coord] coll]
+    (util/warn "Warning: version conflict detected: %s version changes from %s to %s\n" name old-coord new-coord)))
+
 (defn- add-dependencies!
   "Add Maven dependencies to the classpath, fetching them if necessary."
   [old new env]
   (assert (vector? new) "env :dependencies must be a vector")
+  (report-version-conflicts (find-version-conflicts old new env))
   (->> new rm-clojure-dep (assoc env :dependencies) pod/add-dependencies)
   (set-fake-class-path!)
   new)


update to tools.nrepl 0.2.12

update to tools.nrepl 0.2.12

in contrast to 0.2.8 this version supports evaluation
of forms containing reader conditionals

--- boot/core/src/boot/repl.clj
+++ boot/core/src/boot/repl.clj
@@ -2,7 +2,7 @@
   (:require [boot.util :as util]))

 (def ^:dynamic *default-dependencies*
-  (atom '[[org.clojure/tools.nrepl "0.2.8" :exclusions [[org.clojure/clojure]]]]))
+  (atom '[[org.clojure/tools.nrepl "0.2.12" :exclusions [[org.clojure/clojure]]]]))

 (def ^:dynamic *default-middleware*
   (atom (if-not @util/*colorize?* [] ['boot.from.io.aviso.nrepl/pretty-middleware])))


Wikidata-App: Adapted docstring

Wikidata-App: Adapted docstring

--- src/main/clojure/conexp/fca/applications/wikidata.clj
+++ src/main/clojure/conexp/fca/applications/wikidata.clj
@@ -229,18 +229,18 @@
        (get "boolean"))))

 (defn counterexample
-  "Find n counterexample to the given implication, or nil if there is none. If no
-  n is provided, use 1."
+  "find n counterexample to the given implication, or nil if there is none"
   [implication]
   (tautology-or-counterexample
    implication
    (with-sparql-bindings
      (counterexample-query-for-implication implication :limit 1)
      (let [[{entity "entity"}] bindings]
-       entity)))))
+       entity))))

 (defn counterexamples
-  "find all counterexample to the given implication, or nil if there is none"
+  "Find all counterexamples to the given implication, or nil if there is none. If n
+  is provided, find only n counterexamples "
   ([implication]
    (counterexamples implication -1))
   ([implication n]


Minutes as background pie.

Minutes as background pie.

--- ui/src/ui/core.cljs
+++ ui/src/ui/core.cljs
@@ -1,8 +1,10 @@
 (ns ui.core
   (:require [om.core :refer [IRender root]]
-            [om.dom :refer [circle svg text]]
+            [om.dom :refer [circle polygon svg text]]
             [cljs-time.coerce :refer [to-date to-long to-string]]
-            [cljs-time.core :refer [now interval in-seconds]]))
+            [cljs-time.core :refer [now interval in-seconds]]
+            [clojure.string :refer [join]]
+            [goog.math :refer [angleDx angleDy]]))

 (enable-console-print!)

@@ -17,22 +19,33 @@
                          :TimerID ""}))

 (defn timer-view [data owner]
-  (let [elapsed-seconds (in-seconds (interval (to-date (:Start data)) (now)))
-        elapsed-minutes (int (/ elapsed-seconds 60))
-        period-seconds (mod elapsed-seconds 60)]
+  (let [r 200
+        x 250
+        y 250
+        interval-seconds (in-seconds (interval (to-date (:Start data)) (now)))
+        elapsed-minutes (mod (int (/ interval-seconds 60)) 60)
+        elapsed-hours (int (/ interval-seconds 60 60))
+        elapsed-seconds (mod interval-seconds 60)]
     (reify
       IRender
       (render [_]
         (svg #js {:width "500"
                   :height "500"}
-             (circle #js {:r "200"
-                          :cx "250"
-                          :cy "250"
+             (circle #js {:r (+ 20 r)
+                          :cx x
+                          :cy y
                           :fill "green"})
-             (circle #js {:r "180"
-                          :cx "250"
-                          :cy "250"
+             (circle #js {:r r
+                          :cx x
+                          :cy y
                           :fill "white"})
+             (when-not (= 0 elapsed-minutes)
+               (let [minute-points (map #(str (+ x (angleDx % r)) "," (+ y (angleDy % r)))
+                                        (range 0 (* 6 elapsed-minutes) 6))
+                     points-string (join " " (cons (str x "," y) minute-points))]
+                 (polygon #js {:points points-string
+                               :transform (str "rotate(-90," x "," y ")")
+                               :fill "#d9d9d9"})))
              (text #js {:x "120"
                         :y "300"
                         :fill "blue"
@@ -41,7 +54,7 @@
              (text #js {:x "350"
                         :y "300"
                         :fill "blue"}
-                   period-seconds))))))
+                   elapsed-seconds))))))

 (root timer-view app-state
       {:target (. js/document (getElementById "timer"))})


[perf] small perf improvement for nested-text

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- components/src/status_im/ui/components/react.cljs
+++ components/src/status_im/ui/components/react.cljs
@@ -128,9 +128,12 @@

                        (vector? text-element)
                        (let [[options nested-text-elements] text-element]
-                         [nested-text (prepare-text-props
-                                       (utils.core/deep-merge options-with-style
-                                                              options))
+                         [(if (string? nested-text-elements)
+                            text-class
+                            nested-text)
+                          (prepare-text-props
+                           (utils.core/deep-merge options-with-style
+                                                  options))
                           nested-text-elements]))))
              [text-class options-with-style]
              nested-text-elements))))


transparent modals

transparent modals

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- components/src/status_im/ui/components/react.cljs
+++ components/src/status_im/ui/components/react.cljs
@@ -319,5 +319,7 @@
    [(if (= current-view :chat-modal)
       view
       keyboard-avoiding-view)
-    {:flex 1 :flex-direction :column}
+    (merge {:flex 1 :flex-direction :column}
+           (when platform/android?
+             {:background-color :white}))
     (apply vector view styles/flex components)]])


CMR-1955: Removed saved values call.

CMR-1955: Removed saved values call.

--- system-int-test/src/cmr/system_int_test/data2/umm_json.clj
+++ system-int-test/src/cmr/system_int_test/data2/umm_json.clj
@@ -54,7 +54,6 @@
 (defn- collection->umm-json
   "Returns the response of a search in UMM JSON format."
   [version collection]
-  (proto-repl.saved-values/save 2)
   (if (:deleted collection)
     {:meta (collection->umm-json-meta collection)}
     (let [ingested-metadata (umm-legacy/generate-metadata


Strip-console-codes fails gracefully on nil.

--- src-cljs/frontend/models/action.cljs
+++ src-cljs/frontend/models/action.cljs
@@ -38,7 +38,8 @@
 (defn strip-console-codes
   "Strips console codes if output is over 2mb (assuming 2 bytes per char)"
   [message]
-  (string/replace message #"\u001B\[[^A-Za-z]*[A-Za-z]" ""))
+  (when message
+    (string/replace message #"\u001B\[[^A-Za-z]*[A-Za-z]" "")))

 (defn format-output [action output-index]
   "Html-escape the output, and then either:


booking request

booking request

--- src-cljs/kmc_booking/components.cljs
+++ src-cljs/kmc_booking/components.cljs
@@ -230,9 +230,16 @@
 				  valid? (and (validate-name @name)
 							 (validate-phone @phone))
 				  n (count booked)
+				  ids-to-book (reduce (fn [s [id _]]
+          							(str s (if (seq s) ";") id )
+          						) "" booked)
+				  url (str "/api/book"
+									"?name=" (js/encodeURIComponent @name)
+									"&phone=" (js/encodeURIComponent @phone)
+									"&seats=" (js/encodeURIComponent ids-to-book))
 				  ]
 				(if (can-select-more? booked)
-					[:div ;(pr-str booked)
+					[:div
 						[:span.price (str n (ticket-n n) ", " (calc-price booked) " грн ")]

 						(input "Ім'я" name validate-name)
@@ -244,7 +251,7 @@
 									"")
 						 :onClick (fn[e]
 						 	(when valid?
-						 		(ajax "/api/book?foo=bar"
+						 		(ajax url
 						 			nil "POST")


Processing the :li we get from the backend to add a key

--- src-cljs/tropology/core.cljs
+++ src-cljs/tropology/core.cljs
@@ -98,9 +98,9 @@

 (defn replace-link-for-dispatch
   "Given a hiccup structure that's assumed to be a link, we go through it
-  to find the map of properties. If found, and one of these properties is
-  a link with class 'twikilink', then we replace said link for a dispatch
-  to a local route."
+   to find the map of properties. If found, and one of these properties is
+   a link with class 'twikilink', then we replace said link for a dispatch
+   to a local route."
   [attrs extra-params]
   (if (and (map? attrs)
            (= "twikilink" (:class attrs))
@@ -111,19 +111,34 @@
     attrs
     ))

-(defn process-link [element extra-params]
+(defn add-key-meta
+  "Add a meta with the key to all elements in the vector. It's usually called
+   when we are processing a series of :li vectors, since React expects them to
+   have a unique key."
+  [elements]
+  (loop [remaining elements
+         acc       []]
+    (if (empty? remaining)
+      acc
+      (recur (rest remaining)
+             (conj acc ^{:key (hash (first remaining))} (first remaining))))))
+
+(defn process-element [element extra-params]
   "Receives an element as a hiccup structure. If it's a link, then the link
-  is replaced for an action dispatch, otherwise we return the same structure.
-  "
-  (if (and (vector? element)
-           (= :a (first element)))
-    (into [] (map #(replace-link-for-dispatch % extra-params) element))
-    element))
+   is replaced for an action dispatch; for a :ul, it adds a key as meta to all
+   the nested elements; otherwise we return the same structure."
+  (if (vector? element)
+    (condp = (first element)
+      :a (into [] (map #(replace-link-for-dispatch % extra-params) element))
+      :ul (into [:ul] (add-key-meta (rest element)))
+      element)
+    element
+    ))

 (defn process-trope
   "Receives the hiccup data for a trope and processes it before display"
   [coll extra-params]
-  (clojure.walk/prewalk #(process-link % extra-params) coll))
+  (clojure.walk/prewalk #(process-element % extra-params) coll))

 ;


better names and behavior in reactors

better names and behavior in reactors

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

--- plugins/SlideExplorer2/src/slide_explorer/reactors.clj
+++ plugins/SlideExplorer2/src/slide_explorer/reactors.clj
@@ -36,7 +36,7 @@
   "A single-threaded Executor. Call .submit to add Runnables or Callables."
   (Executors/newFixedThreadPool 1))

-(defn add-reactor
+(defn handle-change
   "Adds a watch that submits a function to run on a java executor
    whenever the value of a reference changes. The function's arguments
    should be [old-state new-state]. If executor arg is omitted, a new
@@ -49,20 +49,28 @@
   ([reference function]
     (add-reactor reference function (single-threaded-executor))))

-(defn added-items-reactor
-  "Attaches a single-threaded reactor that applies a function to
-   the set of all items added to a coll inside reference (a ref/atom/agent/var)."
-  [reference function]
-  (add-reactor reference
-               (fn [old-state new-state]
-                 (when-let [diff (diff-coll new-state old-state)]
-                   (function diff)))))
+(defn handle-added-items
+  "Adds a watch that applies a function to each item added to
+   a coll inside reference (a ref/atom/agent/var). The function executes
+   repeatedly on a single-threaded executor, once for each item."
+  ([reference function executor]
+    (add-reactor reference
+                 (fn [old-state new-state]
+                   (when-let [diff (diff-coll new-state old-state)]
+                     (dorun (map function diff))))
+                 executor))
+  ([reference function]
+    (handle-added-items reference function (single-threaded-executor))))

-(defn removed-items-reactor
-  "Attaches a single-threaded reactor that applies a function to
-   the set of all items removed from a coll inside reference (a ref/atom/agent/var)."
-  [reference function]
-  (add-reactor reference
-               (fn [old-state new-state]
-                 (when-let [diff (diff-coll old-state new-state)]
-                   (function diff)))))+
+(defn handle-removed-items
+  "Adds a watch that applies a function to each item removed from
+   a coll inside reference (a ref/atom/agent/var). The function executes
+   repeatedly on a single-threaded executor, once for each item."
+  ([reference function executor]
+    (add-reactor reference
+                 (fn [old-state new-state]
+                   (when-let [diff (diff-coll old-state new-state)]
+                     (dorun (map function diff))))))
+  ([reference function]
+    (handle-removed-items reference function (single-threaded-executor))))


Override of lein parallel-test thread count via env (#276)

--- waiter/project.clj
+++ waiter/project.clj
@@ -114,9 +114,12 @@
                      ;; enable remote debugger to connect on port 5005
                      ["-agentlib:jdwp=transport=dt_socket,server=y,suspend=n,address=5005"]}
              :test {:jvm-opts
-                    [~(str "-Dwaiter.test.kitchen.cmd=" (or
-                                                          (System/getenv "WAITER_TEST_KITCHEN_CMD")
-                                                          (.getCanonicalPath (clojure.java.io/file "../kitchen/bin/run.sh"))))]}
+                    [~(str "-Dwaiter.test.kitchen.cmd=" (or (System/getenv "WAITER_TEST_KITCHEN_CMD")
+                                                            (.getCanonicalPath (clojure.java.io/file "../kitchen/bin/run.sh"))))]
+                    :parallel-test {:pools {:serial (constantly 1)
+                                            :parallel (fn []
+                                                        (or (some-> (System/getenv "LEIN_TEST_THREADS") Long/valueOf)
+                                                            (.availableProcessors (Runtime/getRuntime))))}}}
              :test-console {:jvm-opts
                             ["-Dlog4j.configuration=log4j-console.properties"]}
              :test-log {:jvm-opts


Finish classifier

Finish classifier

--- src/bejeweled_bot/gem_classifier.clj
+++ src/bejeweled_bot/gem_classifier.clj
@@ -15,27 +15,25 @@
   "Takes a map with red/green/blue values, returns the gem type or nil if no gem types match"
   [item]
   (def deltas
-    (reduce
+    (reduce
       (fn [acc gem]
-        (assoc acc gem
+        (assoc acc (first gem)
                (+
-                (abs (- (get item :red)(get (get rgb-to-gem gem) :red)))
-                (abs (- (get item :green)(get (get rgb-to-gem gem) :green)))
-                (abs (- (get item :blue)(get (get rgb-to-gem gem) :blue))))))
+                (abs (- (get item :red)(:red (second gem))))
+                (abs (- (get item :green)(:green (second gem))))
+                (abs (- (get item :blue)(:blue (second gem)))))))
+      nil
       rgb-to-gem))
-  (println
-    (reduce
-      (fn [x y]
-        (min (get deltas x)(get deltas y)))
-      255 ;some relatively big number
-      deltas)))
+
+  ;get the smallest delta
+ ; (get (apply min-key second deltas) 0))
+  (first (apply min-key second deltas)))

 (defn rgb-to-gems
-  [rgb-array]
-
-  (map
-    (fn [row]
-      (fn [item]
-        (classify item))
-      row)
-    rgb-array))
+    [rgb-array]
+    (map
+      (fn [row]
+        (fn [item]
+          (classify item))
+        row)
+      rgb-array))


Fixes documentation.

Fixes documentation.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -824,7 +824,7 @@
   `map-matcher` returns a function that accepts a map and evaluates
   `<consequent>` with all the `<name>`s bound when the message matches
   the given `<clause>`s, otherwise it evaluates `<alternative>`. or
-  throws `IllegalArgumentException` if `<clause>` matches and no
+  throws `IllegalArgumentException` if no `<clause>` matches and no
   `<alternative>` is given.

   Example:


Wrap MIDIDispatch access in array access to support advanced compilation

--- src/alder/audio/midiapi.cljs
+++ src/alder/audio/midiapi.cljs
@@ -1,4 +1,10 @@
 (ns alder.audio.midiapi)
+
+(defn alder-ns-obj []
+  (aget js/window "Alder"))
+
+(defn midi-dispatch-obj []
+  (aget (alder-ns-obj) "MIDIDispatch"))

 (defn has-midi-access []
   (boolean (aget js/navigator "requestMIDIAccess")))
@@ -7,28 +13,28 @@
   (.call (aget js/navigator "requestMIDIAccess") js/navigator))

 (defn add-midi-message-event-listener [device token callback]
-  (.call (aget js/Alder.MIDIDispatch "addMIDIMessageEventListener")
-         js/Alder.MIDIDispatch
+  (.call (aget (midi-dispatch-obj) "addMIDIMessageEventListener")
+         (midi-dispatch-obj)
          device
          token
          callback))

 (defn remove-midi-message-event-listener [device token]
-  (.call (aget js/Alder.MIDIDispatch "removeMIDIMessageEventListener")
-         js/Alder.MIDIDispatch
+  (.call (aget (midi-dispatch-obj) "removeMIDIMessageEventListener")
+         (midi-dispatch-obj)
          device
          token))

 (defn midi-master-device []
-  (aget js/Alder.MIDIDispatch "masterDevice"))
+  (aget (midi-dispatch-obj) "masterDevice"))

 (defn get-current-midi-master-device []
-  (.call (aget js/Alder.MIDIDispatch "currentMasterDevice")
-         js/Alder.MIDIDispatch))
+  (.call (aget (midi-dispatch-obj) "currentMasterDevice")
+         (midi-dispatch-obj)))

 (defn set-current-midi-master-device! [device]
-  (.call (aget js/Alder.MIDIDispatch "currentMasterDevice")
-         js/Alder.MIDIDispatch
+  (.call (aget (midi-dispatch-obj) "currentMasterDevice")
+         (midi-dispatch-obj)
          device))

 (defn node-device [node]
@@ -38,7 +44,7 @@
   (aget event "data"))

 (defn emit-midi-master-device-event [e]
-  (.call (aget js/Alder.MIDIDispatch "onMIDIMessage")
-         js/Alder.MIDIDispatch
+  (.call (aget (midi-dispatch-obj) "onMIDIMessage")
+         (midi-dispatch-obj)
          (midi-master-device)
          (clj->js e)))


Increase card width (to better fit alert messages)

--- src/braid/client/ui/styles/vars.cljs
+++ src/braid/client/ui/styles/vars.cljs
@@ -6,7 +6,7 @@

 (def pad (rem 1))

-(def card-width (rem 17))
+(def card-width (rem 18))

 (def top-bar-height (rem 2))


support local gameplay again

support local gameplay again

--- clojure/src/dnd/core.cljs
+++ clojure/src/dnd/core.cljs
@@ -82,11 +82,12 @@
     (.grabInput #js { :mouse "button" :focus true })
     )

-  (.on client "end" #(let [character-name (:name @character)
-                          string (str "Character '" character-name "' has left the building")]
+  (when client
+    (.on client "end" #(let [character-name (:name @character)
+                             string (str "Character '" character-name "' has left the building")]
                         (remove-client client)
                         (println string)
-                        ))
+                        )))

   ;(.on term "key"  #((let [string (str "key was " %)]
                      ;(println string)
@@ -148,13 +149,25 @@
                            (kick-it new-client))))
     (.listen 2323)))

+(defn create-local []
+  (prn "ok")
+  (let [term (.-terminal tkit)
+        character (make-character)
+        new-client {:term      term
+                    :character character } ]
+    (swap! clients conj new-client)
+    (async
+      (let [dat-name (await (generate-name))]
+        (prn (str dat-name " has joined the fray."))
+        (swap! (:character new-client) assoc :name dat-name)))
+    (kick-it new-client)))
+
 (defn -main []
   (if (-> (last process.argv)
           (= "server"))
     (create-server)
-    (do
-      (def term (.-terminal tkit))
-      (kick-it term))))
+    (create-local)
+    ))

 (set! *main-cli-fn* -main)


add kinda random name to clients

add kinda random name to clients

--- clojure/src/dnd/core.cljs
+++ clojure/src/dnd/core.cljs
@@ -129,11 +129,12 @@
                        (fn [client]
                          (let [term (.createTerminal tkit
                                                      #js {:stdin client :stdout client})
+                               character (make-character)
                                new-client {:client client
                                            :term   term
-                                           :character (make-character) } ]
+                                           :character character } ]
                            (swap! clients conj new-client)
-                           ;(async (swap! character assoc :name (await (generate-name))))
+                           (async (swap! character assoc :name (await (generate-name))))
                            (kick-it new-client))))
     (.listen 2323)))


+(defn nuggent): "new generation": getting there; just need to add lexical complements

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -636,31 +636,18 @@

 ;; (repeatedly #(println (fo (nugent spec1))))
 ;; (repeatedly #(println (fo-ps (nugent spec1))))
-(defn nugent [spec]
+(defn nugent [spec & [take-n]]
   (let [mapping1 (mapping spec (medium) 0 6)
+        take-n (or take-n 100)
         all-of-them
         (mapcat (fn [each-mapping]
                   (let [trellis (apply combo/cartesian-product (vals each-mapping))]
-                    (map (fn [each-path-through-trellis]
-                           (zipmap (keys each-mapping)
-                                   each-path-through-trellis))
-                         trellis)))
+                    (pmap (fn [each-path-through-trellis]
+                            (zipmap (keys each-mapping)
+                                    each-path-through-trellis))
+                          trellis)))
                 mapping1)
-        good-one (first (shuffle all-of-them))]
+        good-one (first (shuffle (take take-n all-of-them)))]
     (do-assocs (get good-one [])
                (keys good-one)
                (vals good-one))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-


fix typo

fix typo

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -129,8 +129,8 @@
           (filter #(not (= % ""))
                   (take
                    10
-                   (repeatedly #(let [foo (generate {:synsem {:cat :verb
-                                                              :modified false
+                   (repeatedly #(let [foo (generate {:modified false
+                                                     :synsem {:cat :verb
                                                               :sem {:pred :be-called}}}
                                                     :model medium)]
                                   (is (not (= "" (fo foo))))


add a new test for parsing a long sentence

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -329,3 +329,24 @@
 (deftest io-dormo-a-casa
   (let [result (parse "io dormo a casa")]
     (is (not (empty? (mapcat :parses result))))))
+
+(deftest parse-long-sentence
+  (let [result (parse "dopo ventotto anni ostana ha un cittadino neonato")]
+    (is (not (empty? (mapcat :parses result))))
+    (is (not (nil?
+              (some
+               #(and (= :have (get-in % [:pred]))
+                     (= :newborn (get-in % [:obj :pred]))
+                     (= :ostana (get-in % [:subj :pred]))
+                     (= :after (get-in % [:mod :pred]))
+                     (= :year (get-in % [:mod :obj :pred]))
+                     (= :twentyeight (get-in % [:mod :obj :spec :def])))
+               (map (fn [parse]
+                      (get-in parse [:synsem :sem]))
+                    (mapcat :parses result))))))))
+
+
+
+
+
+


Cosmetic improvements on identity monad implementation.

--- src/cats/monad/identity.cljc
+++ src/cats/monad/identity.cljc
@@ -25,7 +25,7 @@

 (ns cats.monad.identity
   "The Identity Monad."
-  (:require [cats.protocols :as proto])
+  (:require [cats.protocols :as p])
   (:refer-clojure :exclude [identity]))

 (declare identity-monad)
@@ -35,10 +35,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (deftype Identity [v]
-  proto/Context
+  p/Context
   (get-context [_] identity-monad)

-  proto/Extract
+  p/Extract
   (extract [_] v)

   #?(:clj clojure.lang.IDeref
@@ -56,11 +56,11 @@
          (str v))])

   #?@(:cljs
-       [cljs.core/IEquiv
-        (-equiv [_ other]
-                (if (instance? Identity other)
-                  (= v (.-v other))
-                  false))]))
+      [cljs.core/IEquiv
+       (-equiv [_ other]
+         (if (instance? Identity other)
+           (= v (.-v other))
+           false))]))

 (alter-meta! #'->Identity assoc :private true)

@@ -76,18 +76,18 @@
 (def ^{:no-doc true}
   identity-monad
   (reify
-    proto/Functor
+    p/Functor
     (fmap [_ f iv]
       (Identity. (f (.-v iv))))

-    proto/Applicative
+    p/Applicative
     (pure [_ v]
       (Identity. v))

     (fapply [_ af av]
       (Identity. ((.-v af) (.-v av))))

-    proto/Monad
+    p/Monad
     (mreturn [_ v]
       (Identity. v))

@@ -102,9 +102,9 @@
   "The Identity transformer constructor."
   [inner-monad]
   (reify
-    proto/Monad
+    p/Monad
     (mreturn [_ v]
-      (identity (proto/mreturn inner-monad v)))
+      (identity (p/mreturn inner-monad v)))

     (mbind [_ mv f]
       nil)))


Fix interpolate-curve when curve has exactly two points

--- src/clj/genartlib/curves.clj
+++ src/clj/genartlib/curves.clj
@@ -115,10 +115,8 @@

       (= 2 (count curve))
       (let [mid-x (interpolate (first first-point) (first last-point) t)
-            mid-y (interpolate (second first-point) (second last-point) t)
-            mid-point [mid-x mid-y]]
-        [[first-point mid-point]
-         [mid-point last-point]])
+            mid-y (interpolate (second first-point) (second last-point) t)]
+        [mid-x mid-y])

       :else
       (let [total-len (or curve-len (curve-length curve))


add second slider

add second slider

--- src/cljs/calligrid/core.cljs
+++ src/cljs/calligrid/core.cljs
@@ -12,15 +12,18 @@
 (defn lines [nol dist]
   (for [y (range 5 (* nol dist) dist)]
     (line y)))
-
-(defn change-function [e] (.log js/console (.. e -target -value)))

-(defn slider-change [event] (.log js/console event))
+(defn change-number [event]
+  (swap! app-state assoc :number-of-lines (.. event -target -value)))
+
+(defn change-distance [event]
+  (swap! app-state assoc :distance (js/parseInt (.. event -target -value))))

 (defn page []
   (let [{:keys [number-of-lines distance]} @app-state]
     [:div
-     [:input {:type "range" :min 10 :max 30 :step 1 :on-change slider-change}]
+     [:input {:type "range" :min 10 :max 30 :step 1 :on-change change-number}]
+     [:input {:type "range" :min 10 :max 30 :step 1 :on-change change-distance}]
      [:h1 (str "number of lines: " number-of-lines)]
      [:svg {:width 600 :height 800}
       (lines number-of-lines distance)]]))


Side handling

Side handling

--- src/cljs/netrunner/game.cljs
+++ src/cljs/netrunner/game.cljs
@@ -8,7 +8,7 @@
 (def app-state
   (atom {:gameid 0
          :log []
-         :side "Corp"
+         :side :corp
          :corp {:user nil
                 :r&d []
                 :hq []
@@ -34,7 +34,7 @@
                   :brain-damage 0}}{}))

 (defn init-game [gameid side corp runner]
-  (swap! app-state assoc :gameid gameid :side side)
+  (swap! app-state assoc :gameid gameid :side (keyword (.toLowerCase side)))
   (swap! app-state assoc-in [:runner :user] (:user runner))
   (swap! app-state assoc-in [:corp :user] (:user corp)))

@@ -117,26 +117,30 @@
 (defn discard []
   (if (= (:side app-state) :runner) :heap :archive))

-(defn gameboard [cursor owner]
+(defn gameboard [{:keys [side] :as cursor} owner]
   (om/component
    (sab/html
-    [:div.gameboard {}
-     [:div.leftpane {}
-      [:div {}
-       (om/build corp-stats-view (:corp cursor))
-       (om/build scored-view cursor)]
-      [:div {}
-       (om/build scored-view cursor)
-       (om/build runner-stats-view (:runner cursor))]]
+    [:div.gameboard
+     [:div.leftpane
+      [:div
+       (if (= side :corp)
+         (om/build runner-stats-view (:runner cursor))
+         (om/build corp-stats-view (:corp cursor)))
+       (om/build scored-view ((if (= side :corp) :runner :corp) cursor))]
+      [:div
+       (om/build scored-view (side cursor))
+       (if (= side :corp)
+         (om/build corp-stats-view (:corp cursor))
+         (om/build runner-stats-view (:runner cursor)))]]
      [:div.centralpane
       (om/build corp-board (:corp cursor))
       (om/build runner-board (:runner cursor))
-      [:div.dashboard {}
+      [:div.dashboard
        (om/build hand-view ((hand) cursor))
        (om/build deck-view ((deck) cursor))
        (om/build discard-view ((discard) cursor))]]
      [:div.rightpane {}
-      [:div.card-zoom {}]
+      [:div.card-zoom]
       (om/build log-pane (:log cursor))
       (om/build msg-input-view cursor)]])))


Fixes vexing concurrency bug in proxy where downstream resume can get in front of updating proxy state (client downstream function, i.e. connection established).

--- src/clojure/picard/proxy.clj
+++ src/clojure/picard/proxy.clj
@@ -65,8 +65,8 @@
   [[hdrs body] opts]
   [(-> hdrs
        add-xff-header
-       (set-scheme opts)
-       ) body])
+       (set-scheme opts))
+   body])

 (defn- proxy-loop?
   [[{[remote-ip] :remote-addr xff-header "x-forwarded-for"}] {cycles :cycles}]
@@ -85,52 +85,64 @@
    (addr-from-req req) req opts
    (fn [client-dn]
      (fn [evt val]
-       (debug {:msg "Client event"
-               :event [evt val]})
-       (try
-         (cond
-          (= :response evt)
-          (do
-            ;; Because, I think that there might be some crazy race
-            ;; condition where the response gets sent before :connected
-            ;; TODO: Make sure that this isn't the case.
-            (locking req
-              (when (= :pending (@state :upstream))
-                (downstream :resume nil))
-              (swap! state #(assoc % :upstream client-dn :responded? true)))
-            (downstream evt val))
+       (debug {:msg "Client event" :event [evt val]})
+       (cond
+        ;; connected, resume if we're paused
+        (= :connected evt)
+        (locking req
+          (let [pending (= :pending (@state :upstream))]
+            (swap! state #(assoc % :upstream client-dn))
+            (when pending (downstream :resume nil))))

-          (= :body evt)
-          (downstream evt val)
+        ;; response, resume if we're paused
+        (= :response evt)
+        (do
+          ;; Because, I think that there might be some crazy race
+          ;; condition where the response gets sent before :connected
+          ;; TODO: Make sure that this isn't the case.
+          ;; TODO: the real issue here is that the client doesn't
+          ;; always send :connected
+          (locking req
+            (let [pending (= :pending (@state :upstream))]
+              (swap! state #(assoc % :upstream client-dn :responded? true))
+              (when pending (downstream :resume nil))))

-          (= :connected evt)
-          (locking req
-            (when (= :pending (@state :upstream))
-              (downstream :resume nil))
-            (swap! state #(assoc % :upstream client-dn)))
+          ;; send the response back to the server socket
+          (downstream evt val))

-          (= :abort evt)
-          (do
-            (swap! state #(dissoc % :upstream))
-            (let [current-state @state]
-              (cond
-               (bad-gateway? current-state val)
-               (downstream :response bad-gateway)
+        ;; body, send downstream
+        (= :body evt)
+        (downstream evt val)

-               (service-unavailable? current-state val)
-               (downstream :response service-unavailable)
+        ;; abort
+        (= :abort evt)
+        (do
+          (swap! state #(dissoc % :upstream))
+          (let [current-state @state]
+            (cond
+             (bad-gateway? current-state val)
+             (downstream :response bad-gateway)

-               (gateway-timeout? current-state val)
-               (downstream :response gateway-timeout)
+             (service-unavailable? current-state val)
+             (downstream :response service-unavailable)

-               :else
-               (downstream evt val))))
+             (gateway-timeout? current-state val)
+             (downstream :response gateway-timeout)

-          (not= :done evt)
-          (downstream evt val))
-         (catch Exception e
-           (.printStackTrace e))))))
+             :else
+             (downstream evt val))))

+        ;; done (don't send)
+        (= :done evt)
+        nil
+
+        ;; all other events send downstream
+        :else
+        (downstream evt val)))))
+
+  ;; when the request is chunked, note that we're pending
+  ;; connection and pause the server while we wait for the client
+  ;; to connect
   (when (chunked? req)
     (locking req
       (when-not (@state :upstream)
@@ -148,21 +160,27 @@
        (fn [downstream]
          (let [state (atom {})]
            (defstream
+
              ;; Handling the initial request
              (request [req]
-               (debug {:msg   "Receiving request"
-                       :event [:request req]})
-               (if (proxy-loop? req opts)
+               (debug {:msg "Receiving request" :event [:request req]})
+
+               (if-not (proxy-loop? req opts)
+                 ;; not a proxy loop, initiate the request
+                 (let [req (process-request req opts)]
+                   (initiate-request state opts req downstream))
+
+                 ;; proxy loop, return bad gateway
                  (do
-                   (debug {:msg   "In proxy loop"
-                           :event [:request req]})
-                   (downstream :response bad-gateway))
-                 (initiate-request
-                  state opts
-                  (process-request req opts)
-                  downstream)))
-             (done []) ;; We don't care about this
-             ;; Handling all other events
+                   (debug {:msg   "In proxy loop" :event [:request req]})
+                   (downstream :response bad-gateway))))
+
+             ;; ignore :done events
+             (done [])
+
+             ;; all other events go upstream (client's downstream)
              (else [evt val]
-               (when-let [upstream (@state :upstream)]
-                 (upstream evt val)))))))))
+               (let [upstream (@state :upstream)]
+                 (if (and upstream (not= :pending upstream))
+                   (upstream evt val)
+                   (throw (Exception. (str "proxy is not expecting message, " [evt val]))))))))))))


Remove import

Remove import

--- src/discuss/utils/views.cljs
+++ src/discuss/utils/views.cljs
@@ -6,8 +6,7 @@
             [om.dom :as dom]
             [discuss.utils.common :as lib]
             [discuss.references.lib :as rlib]
-            [discuss.translations :refer [translate] :rename {translate t}]
-            [discuss.communication.lib :as comlib]))
+            [discuss.translations :refer [translate] :rename {translate t}]))

 (defn button [f display-text]
   [:div.btn.btn-primary {:style {:marginRight "0.5em"}


(TK-168) Lump `:client-auth` with other security-related settings

This commit moves `:client-auth` up with the other security settings
so that the commentary above those can be applied to it as well.

Also fixes a place where we had a hard-coded `:need` that should
have been referencing the var for the default.

--- src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
+++ src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
@@ -72,6 +72,7 @@
    "SSL_RSA_WITH_3DES_EDE_CBC_SHA"
    "SSL_RSA_WITH_RC4_128_MD5"])
 (def default-protocols ["TLSv1" "TLSv1.1" "TLSv1.2"])
+(def default-client-auth :need)

 ;; TODO: these two need to be addressed in our upcoming work around
@@ -79,7 +80,6 @@
 (def default-max-threads 100)
 (def default-queue-max-size (Integer/MAX_VALUE))

-(def default-client-auth :need)
 (def default-jmx-enable "true")
 (def default-request-header-buffer-size 8192)
 (def default-request-header-size 8192)
@@ -313,7 +313,7 @@
   [config :- WebserverRawConfig]
   (let [client-auth (:client-auth config)]
     (cond
-      (nil? client-auth) :need
+      (nil? client-auth) default-client-auth
       (contains? #{"need" "want" "none"} client-auth) (keyword client-auth)
       :else (throw
               (IllegalArgumentException.


Changed textarea instructions to something more descriptive of what needs to be done

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -104,7 +104,7 @@
          [:u "Special Restrictions"] [:br]
          (map (partial vector :li) restricted)])]
      [:div
-      [:b "Enter your code:" [:br]
+      [:b "Code which fills in the blank:" [:br]
        [:span {:class "error"} (session/flash-get :error)]]]
      (form-to [:post "/run-code"]
               (text-area {:id "code-box"


Make operations nil-safe: if any of arguments to the combiner functions are nil,  return nil. It will be skipped on the last aggregation step when returning results.

--- src/io/cyanite/query/ast.clj
+++ src/io/cyanite/query/ast.clj
@@ -2,6 +2,13 @@
   (:require [clojure.string :as s]))

 (def ^:dynamic *series*)
+
+(defn nil-safe-op
+  [f]
+  (fn [& vals]
+    (if (some nil? vals)
+      nil
+      (apply f vals))))

 (defprotocol SeriesTransform
   "A protocol to realize operations on series."
@@ -68,7 +75,7 @@
 (defn traverse!
   [repr outer inner & series]
   (let [renamed (series-rename series repr)]
-    [renamed [[renamed (apply mapv outer (flatten-series inner series))]]]))
+    [renamed [(apply mapv (nil-safe-op outer) (flatten-series (nil-safe-op inner) series))]]))

 (extend-protocol SeriesTransform
   String


(PDB-2788) Add initial full filesystem tests

--- test/stockpile_test.clj
+++ test/stockpile_test.clj
@@ -3,10 +3,11 @@
             [clojure.java.io :as io]
             [clojure.java.shell :as shell]
             [clojure.test :refer :all])
-  (:import [org.apache.commons.lang3 RandomStringUtils]
-           [java.io ByteArrayInputStream File]
-           [java.nio.file Files NoSuchFileException]
-           [java.nio.file.attribute FileAttribute]))
+  (:import
+   [org.apache.commons.lang3 RandomStringUtils]
+   [java.io ByteArrayInputStream File IOException]
+   [java.nio.file Files NoSuchFileException OpenOption StandardOpenOption]
+   [java.nio.file.attribute FileAttribute]))

 (def small-test-fs
   (if-let [v (System/getenv "STOCKPILE_TINY_TEST_FS")]
@@ -160,6 +161,45 @@
            (test-discard-entry-to dest tmpdir "q2")
            (finally
              (Files/delete dest))))))))
+
+(defn fill-filesystem [path]
+  "Returns truish value if the filesystem containing path is likely full."
+  (let [append StandardOpenOption/APPEND
+        buf (byte-array (* 64 1024) (byte \?))
+        write-chunks (fn [write-chunk open-opts]
+                       (with-open [out (Files/newOutputStream
+                                        path
+                                        (into-array OpenOption open-opts))]
+                         (try
+                           (while true (write-chunk out))
+                           (catch IOException ex true))))]
+    ;; Write smaller and smaller chunks; finish up with single bytes.
+    (write-chunks #(.write % buf 0 (* 64 1024)) [])
+    (write-chunks #(.write % buf 0 1024) [append])
+    (write-chunks #(.write % (int \?)) [append])))
+
+(deftest full-filesystem-behavior
+  (when small-test-fs
+    (let [qdir (.resolve small-test-fs "full-q")
+          nopedir (.resolve small-test-fs "no-q")
+          q (stock/create qdir)
+          balloon (Files/createTempFile small-test-fs "balloon-" ""
+                                        (into-array FileAttribute []))]
+      (try
+        (let [firehose (future (fill-filesystem balloon))
+              result (deref firehose (* 30 1000) nil)]
+          (is result)
+          (if-not result
+            (future-cancel firehose)
+            (let [free (.getUsableSpace (Files/getFileStore balloon))]
+              (is (= 0 free))
+              (when (zero? free)
+                (is (thrown? IOException (stock/create nopedir)))
+                (is (thrown? IOException (store-str q "foo")))))))
+        (finally
+          (Files/delete balloon)))
+      (let [[q read-entries] (stock/open qdir conj ())]
+        (is (= [] read-entries))))))

 (def billion 1000000000)


Update run-main to use the new require macro

And delete lots of the machinery no
longer needed.

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -311,108 +311,6 @@
                     (if e
                       (print-error e false)
                       (reset! current-ns ns-name))))))))))))
-
-(defn- canonicalize-specs
-  [specs]
-  (letfn [(canonicalize [quoted-spec-or-kw]
-            (if (keyword? quoted-spec-or-kw)
-              quoted-spec-or-kw
-              (as-> (second quoted-spec-or-kw) spec
-                (if (vector? spec) spec [spec]))))]
-    (map canonicalize specs)))
-
-(defn- purge-analysis-cache!
-  [state ns]
-  (swap! state (fn [m]
-                 (assoc m ::ana/namespaces (dissoc (::ana/namespaces m) ns)))))
-
-(defn- purge!
-  [names]
-  (doseq [name names]
-    (purge-analysis-cache! st name))
-  (apply swap! cljs.js/*loaded* disj names))
-
-(defn- process-reloads!
-  [specs]
-  (if-let [k (some #{:reload :reload-all} specs)]
-    (let [specs (->> specs (remove #{k}))]
-      (if (= k :reload-all)
-        (purge! @cljs.js/*loaded*)
-        (purge! (map first specs)))
-      specs)
-    specs))
-
-(defn- self-require?
-  [specs]
-  (some
-    (fn [quoted-spec-or-kw]
-      (and (not (keyword? quoted-spec-or-kw))
-           (let [spec (second quoted-spec-or-kw)
-                 ns   (if (sequential? spec)
-                        (first spec)
-                        spec)]
-             (= ns @current-ns))))
-    specs))
-
-(defn- make-ns-form
-  [kind specs target-ns]
-  (if (= kind :import)
-    (with-meta `(~'ns ~target-ns
-                  (~kind
-                    ~@(map (fn [quoted-spec-or-kw]
-                             (if (keyword? quoted-spec-or-kw)
-                               quoted-spec-or-kw
-                               (second quoted-spec-or-kw)))
-                        specs)))
-      {:merge true :line 1 :column 1})
-    (with-meta `(~'ns ~target-ns
-                  (~kind
-                    ~@(-> specs canonicalize-specs process-reloads!)))
-      {:merge true :line 1 :column 1})))
-
-(defn- log-ns-form
-  [kind ns-form]
-  (when (:verbose @app-env)
-    (println-verbose "Implementing"
-      (name kind)
-      "via ns:\n  "
-      (pr-str ns-form))))
-
-(defn- compiler-state-memo
-  []
-  {:st     @st
-   :loaded @cljs/*loaded*})
-
-(defn- restore-compiler-state
-  [memo]
-  (reset! st (:st memo))
-  (reset! cljs/*loaded* (:loaded memo)))
-
-(defn- process-require
-  [kind cb specs]
-  (let [memo (compiler-state-memo)]
-    (try
-      (let [is-self-require? (and (= kind :require) (self-require? specs))
-            [target-ns restore-ns]
-            (if-not is-self-require?
-              [@current-ns nil]
-              ['cljs.user @current-ns])]
-        (cljs/eval
-          st
-          (let [ns-form (make-ns-form kind specs target-ns)]
-            (log-ns-form kind ns-form)
-            ns-form)
-          (make-base-eval-opts)
-          (fn [{e :error}]
-            (when is-self-require?
-              (reset! current-ns restore-ns))
-            (when e
-              (handle-error e false)
-              (restore-compiler-state memo))
-            (cb))))
-      (catch :default e
-        (handle-error e true)
-        (restore-compiler-state memo)))))

 (defn- resolve-var
   "Given an analysis environment resolve a var. Analogous to
@@ -952,24 +850,25 @@

 (defn- ^:export run-main
   [main-ns & args]
-  (let [main-args (js->clj args)]
+  (let [main-args (js->clj args)
+        opts (make-base-eval-opts)]
     (binding [cljs/*load-fn* load
               cljs/*eval-fn* caching-js-eval]
-      (process-require
-        :require
-        (fn [_]
-          (cljs/eval-str st
-            (str "(var -main)")
-            nil
-            (merge (make-base-eval-opts)
-              {:ns         (symbol main-ns)
-               :source-map true})
-            (fn [{:keys [ns value error] :as ret}]
-              (try
-                (apply value args)
-                (catch :default e
-                  (handle-error e true))))))
-        `[(quote ~(symbol main-ns))]))
+      (cljs/eval st
+        `(~'require (quote ~(symbol main-ns)))
+        opts
+        (fn [{:keys [ns value error] :as ret}]
+          (if error
+            (handle-error error true)
+            (cljs/eval-str st
+              (str "(var -main)")
+              nil
+              (merge opts {:ns (symbol main-ns)})
+              (fn [{:keys [ns value error] :as ret}]
+                (try
+                  (apply value main-args)
+                  (catch :default e
+                    (handle-error e true)))))))))
     nil))

 (defn- load-core-source-maps!


Allow type to be omitted when using import-javascript-library (defaults to :context)

--- src/main/clojure/cascade.clj
+++ src/main/clojure/cascade.clj
@@ -119,20 +119,23 @@
   (struct-map dom-node :type :text :value s))

 (defn import-javascript-library
-	"Imports a JavaScript library from the given path. type identifies where it comes from (:classpath or :context).
+	"Imports a JavaScript library from the given path. type identifies where it comes from (:classpath or :context,
+	the two parameter version assumes :context).
 	Path should not start with a slash. Duplicate imports of the same library are ignored.
 	Imported libraries are added as <script> links
 	to the final page at the top of the <html>/<head> element (if present). Returns nil."
-	[env type path]
-	(let [asset-map (get-asset env type path)
-			  aggregation (-> env :cascade :resource-aggregation)
-			  libraries (@aggregation :libraries)]
-		(when-not (contains? libraries asset-map)
-			(debug "Importing library: %s" (ppstring asset-map))
-			; Note: under some race conditions, we could end up with the same map added twice.
-			; That may be an issue when we have true parallel rendering.
-			(swap! aggregation update-in [:libraries] conj asset-map))))
-
+	([env path]
+		(import-javascript-library env :context path))
+	([env type path]
+		(let [asset-map (get-asset env type path)
+				  aggregation (-> env :cascade :resource-aggregation)
+				  libraries (@aggregation :libraries)]
+			(when-not (contains? libraries asset-map)
+				(debug "Importing library: %s" (ppstring asset-map))
+				; Note: under some race conditions, we could end up with the same map added twice.
+				; That may be an issue when we have true parallel rendering.
+				(swap! aggregation update-in [:libraries] conj asset-map)))))
+


Upgrading to latest bidi

Upgrading to latest bidi

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -1,12 +1,12 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/bidi "0.9.1"
+(defproject juxt.modular/bidi "0.9.2"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
   :dependencies [[com.stuartsierra/component "0.2.2"]
-                 [bidi "1.18.7"]
+                 [bidi "1.18.9"]
                  [juxt.modular/ring "0.5.2"]
                  [prismatic/schema "0.3.5"]]
   :profiles {:dev


More modifications for simulation computation

efficient-simulator-sets now uses HashSet again.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/dl/languages/description_graphs.clj
+++ src/conexp/contrib/dl/languages/description_graphs.clj
@@ -13,7 +13,7 @@
         conexp.contrib.dl.framework.semantics
         conexp.contrib.dl.util.graphs)
   (:use clojure.contrib.pprint)
-  (:import [java.util HashMap LinkedList]))
+  (:import [java.util HashMap HashSet]))

 (ns-doc
  "Implements description graphs and common operations on them.")
@@ -418,8 +418,9 @@
         (.put remove [v r]
               (set-of w [w base-set-2,
                          :let [post-w (post-2 w r)]
-                         :when (and (seq post-w) ;i.e. (not (empty? post-w))
-                                    (empty? (intersection (.get sim v) post-w)))]))))
+                         :when (seq post-w) ;i.e. (not (empty? post-w))
+                         :let [sim-v (.get sim v)]
+                         :when (forall [x post-w] (not (contains? sim-v x)))]))))
     (doseq [w base-set-2]
       (.put pre* w
             (set-of [u r] [r R, u (pre-2 w r)])))
@@ -440,7 +441,7 @@
         ^HashMap remove (nth vars 1),
         ^HashMap pre*   (nth vars 2),

-        ^LinkedList non-empty-removes (LinkedList.),
+        ^HashSet non-empty-removes (HashSet.),

         base-set-1 (:base-set G-1),
         post-2     (:post G-2),
@@ -448,8 +449,8 @@
     (doseq [v base-set-1,
             r R,
             :when (seq (.get remove [v r]))] ;i.e. (not (empty? (.get remove [v r])))
-      (.addFirst non-empty-removes [v r]))
-    (while-let [[v r] (.peekFirst non-empty-removes)]
+      (.add non-empty-removes [v r]))
+    (while-let [[v r] (first non-empty-removes)]
       (doseq [w (.get remove [v r]),
               u (pre-1 v r)]
         (when (contains? (.get sim u) w)
@@ -461,9 +462,9 @@
                     (not (contains? sim-u x)))
               (.put remove [u r*]
                     (conj (.get remove [u r*]) w*))
-              (.addLast non-empty-removes [u r*])))))
+              (.add non-empty-removes [u r*])))))
       (.put remove [v r] #{})
-      (.removeFirst non-empty-removes))
+      (.remove non-empty-removes [v r]))
     (HashMap->hash-map sim)))


don't return tables and id fields if a table is not :active true

--- src/metabase/api/meta/db.clj
+++ src/metabase/api/meta/db.clj
@@ -112,13 +112,13 @@
 (defendpoint GET "/:id/tables"
   "Get a list of all `Tables` in `Database`."
   [id]
-  (sel :many Table :db_id id (order :name)))
+  (sel :many Table :db_id id :active true (order :name)))

 (defendpoint GET "/:id/idfields"
   "Get a list of all primary key `Fields` for `Database`."
   [id]
   (read-check Database id)
-  (let [table_ids (sel :many :id Table :db_id id)]
+  (let [table_ids (sel :many :id Table :db_id id :active true)]
     (-> (sel :many Field :table_id [in table_ids] :special_type "id")
         (hydrate :table))))