Fix testing non-empty input

Fix testing non-empty input

--- src/sparql_to_csv/cli.clj
+++ src/sparql_to_csv/cli.clj
@@ -7,7 +7,8 @@
             [clojure.tools.cli :refer [parse-opts]]
             [mount.core :as mount]
             [clojure.java.io :as io]
-            [slingshot.slingshot :refer [try+]]))
+            [slingshot.slingshot :refer [try+]])
+  (:import (java.io File Reader)))

 ; ----- Private functions -----

@@ -25,8 +26,7 @@

 (defn- error-msg
   [errors]
-  (str "The following errors occurred while parsing your command:\n\n"
-       (util/join-lines errors)))
+  (util/join-lines (cons "The following errors occurred while parsing your command:\n" errors)))

 (defn- validate-template
   [template]
@@ -39,18 +39,25 @@
   ; TODO: clojure.spec validation
   )

-(defn has-input?
+(defmulti has-input?
   "Test if `input` provides something."
-  ; FIXME: Doesn't work correctly with Leiningen (i.e. using `lein run`).
+  type)
+
+(defmethod has-input? File
   [input]
   (with-open [reader (io/reader input)]
     (.ready reader)))
+
+(defmethod has-input? Reader
+  [input]
+  (let [c (.read input)]
+    (.unread input c)
+    (boolean c)))

 (defn- main
   [{:keys [endpoint input]
     :as params}
    template]
-  ; TODO: Handle non-recoverable exceptions
   (validate-params params)
   (validate-template template)
   (let [piped? (has-input? input)


few more changes

few more changes

--- src/start_clojure/core.clj
+++ src/start_clojure/core.clj
@@ -3,10 +3,23 @@
 	(:require	[compojure.route :as route]
 				[compojure.handler :as handler]))

+(defn index-page []
+	(str "hi hi hi"))
+
+
 (defroutes main-routes
-	(GET "/" [] "
HI HI HI
")
+	(GET "/" [] (index-page))
+
+	(POST "/post" []
+		(str "tbd"))
+	(GET "/post/:id" [id]
+		(str "
post " id "
"))
+	(PUT "/post/:id" [id]
+		(str "tbd id " id))
+
 	(route/resources "/")
 	(route/not-found "Page not found"))

 (def app
 	(handler/site main-routes))
+


Add ThinAeroFoilTheory for cambered foils Added functions: * `(gradient-forward-polar-function)` * `(gradient-aft-polar-function)` * `(theta-switch)` Modified `(coefficient-of-lift)` to accomidate cambered foils ** NEEDS TESTING **

--- src/hydrofoil/model.clj
+++ src/hydrofoil/model.clj
@@ -88,6 +88,32 @@
        (* (thickness-function individual x)
           (Math/cos (Math/atan (gradient-function individual x)))))))

+(defn gradient-forward-polar-function
+  "takes a theta-not and gives a y coordinate. This is used in the coefficient-of-lift calculations.
+  (M(-c + 2P + c*Cos(theta-not)))/P^2"
+  [individual theta-not]
+  (let [position-camber (individual :corrected-position-camber)
+        max-camber (individual :corrected-max-camber)]
+    (* (/ max-camber (Math/pow position-camber 2))
+       (+ (* (-1) 1) (* 2 position-camber) (* 1 (Math/cos theta-not))))))
+
+(defn gradient-aft-polar-function
+  "takes a theta-not and gives a y coordinate. This is used in the coefficient-of-lift calculations.
+  (M (-c + 2P + c*Cos(theta-not)))/(-1 + P)^2"
+  [individual theta-not]
+  (let [position-camber (individual :corrected-position-camber)
+        max-camber (individual :corrected-max-camber)]
+    (* (/ max-camber (Math/pow (- position-camber 1) 2))
+       (+ (* (-1) 1) (* 2 position-camber) (* 1 (Math/cos theta-not))))))
+
+(defn theta-switch
+  "The angle at which the coefficient-of-lift calculation will switch from one integration to another
+  arccos(1 - 2P)"
+  [individual]
+  (let [position-camber :corrected-position-camber]
+    (Math/acos (- 1 (* 2 position-camber)))))
+
+
 ;;;---------------- Derivative -------------------
 (defn derivative
   "takes an individual, a function, and an x and returns a derivative at that point
@@ -173,13 +199,28 @@
      (simpson-integral individual adjusted-lower-function 90)))

 ;;;---------------- Coefficantof lift ----------------
-(defn coefficient-of-lift
+(defn symetric-coefficient-of-lift
   [individual run-constants]
   (let [attack-angle (run-constants :angle-of-attack)
         camber-position (individual :corrected-position-camber)]
     (* (* 2 (Math/PI))
        (+ attack-angle (* 2 camber-position)))))

+(defn cambered-coefficient-of-lift
+  [individual run-constants]
+  (let [attack-angle (run-constants :angle-of-attack)
+        theta-switch-constant (theta-switch individual)]
+    (- (* 2 (Math/PI))
+       (* 2 (+ (integral-production individual gradient-forward-polar-function 0 theta-switch-constant (/ theta-switch-constant 90) 90)
+               (integral-production individual gradient-aft-polar-function theta-switch-constant (Math/PI) (/ theta-switch-constant 90) 90))))))
+
+
+(defn coefficient-of-lift
+  [individual run-constants]
+  (let [max-camber (individual :max-camber)]
+    (if (== max-camber 0)
+      (symetric-coefficient-of-lift individual run-constants)
+      (cambered-coefficient-of-lift individual run-constants))))

@@ -197,9 +238,3 @@
 ;;(integral-abstracted (hash-map :corrected-max-camber 0 :corrected-position-camber 0 :corrected-thickness 0.45) upper-surface-y-function left-rule 100)

 ;(upper-surface-y-function (hash-map :corrected-max-camber 0 :corrected-position-camber 0.5 :corrected-thickness 0.45) 0)
-
-
-
-
-
-


Implement work-items and tags properly in State

--- src/custard/core.clj
+++ src/custard/core.clj
@@ -39,9 +39,15 @@
                 (filter #(= "component" (:kind %))))
           (:nodes graph)))
   (work-items [this]
-    (mapv #(get-in graph %) (:work-items graph)))
+    (into []
+          (comp (map #(get-in graph %))
+                (filter #(= "work-item" (:kind %))))
+          (:nodes graph)))
   (tags [this]
-    (mapv #(get-in graph %) (:tags graph))))
+    (into []
+          (comp (map #(get-in graph %))
+                (filter #(= "tag" (:kind %))))
+          (:nodes graph))))

 ;;;; The uncommitted state (working directory)


added transforms

added transforms

--- src/temperaments/core.clj
+++ src/temperaments/core.clj
@@ -62,6 +62,7 @@

 (if (not (o/server-connected?))
   (o/boot-external-server))
+  ;(o/connect-external-server 60106))

 (require '[overtone.inst.synth :as syn])

@@ -469,22 +470,24 @@
         part (map vector notes rhy)]
     (play (o/metronome @tempo) (str->instr instr) part {:midi true})))

-(defn remove-circle [id kw]
-  (let [len (get-in @melody-map [id kw])
-        kwstring (case kw
-                   :pitches "-mel-"
-                   :beats   "-rhy-")
-        idprefix (s/join ["#kb-" id kwstring])
-        idlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))
-        root (get-in @melody-map [id :root])
-        panel (select root [:#kb])
-        circhash (atom {})]
-    ;(println idlist)
-    (doseq [k idlist]
-      (let [w (select panel [k])]
-        (swap! circhash assoc k (value w))
-        (remove! panel w)))
-    @circhash))
+(defn remove-circle
+  ([id kw] (remove-circle id kw true))
+  ([id kw del?]
+   (let [len (get-in @melody-map [id kw])
+         kwstring (case kw
+                    :pitches "-mel-"
+                    :beats   "-rhy-")
+         idprefix (s/join ["#kb-" id kwstring])
+         idlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))
+         root (get-in @melody-map [id :root])
+         panel (select root [:#kb])
+         circhash (atom {})]
+                                        ;(println idlist)
+     (doseq [k idlist]
+       (let [w (select panel [k])]
+         (swap! circhash assoc k (value w))
+         (when del? (remove! panel w))))
+     @circhash)))

 (defn change-circle-mel [id newnum]
   (let [root (get-in @melody-map [id :root])
@@ -492,13 +495,15 @@
         rhyvals (remove-circle id :beats)
         len (get-in @melody-map [id :beats])
         idprefix (s/join ["#kb-" id "-rhy-"])
-        kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))]
+        kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))
+        transtag (keyword (s/join ["#kb-" id "-mel-translate"]))
+        transbut (select root [transtag])]
     (remove-circle id :pitches)
     (swap! melody-map assoc-in [id :pitches] newnum)
     (config! panel :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
     (doseq [kw kwlist]
       (value! (select panel [kw]) (get rhyvals kw)))
-    ))
+    (config! transbut :model (range newnum))))

 (defn change-circle-rhy [id newnum]
   (let [root (get-in @melody-map [id :root])
@@ -506,14 +511,88 @@
         melvals (remove-circle id :pitches)
         len (get-in @melody-map [id :pitches])
         idprefix (s/join ["#kb-" id "-mel-"])
-        kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))]
+        kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))
+        transtag (keyword (s/join ["#kb-" id "-rhy-translate"]))
+        transbut (select root [transtag])]
     (remove-circle id :beats)
     (swap! melody-map assoc-in [id :beats] newnum)
     (config! panel :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
     (doseq [kw kwlist]
       (value! (select panel [kw]) (get melvals kw)))
-    ))
-
+    (config! transbut :model (range newnum))))
+
+(defn id->root [id]
+  (get-in @melody-map [id :root]))
+
+(defn id->panel [id]
+  (let [root (id->root id)]
+    (select root [:#kb])))
+
+(defn make-kw-list [prefix len]
+  (vec (map #(keyword (s/join [prefix (str %)])) (range len))))
+
+(defn kw->idtag [kw]
+  (let [word (subs (str kw) 1)]
+    (keyword (s/join ["#" word]))))
+
+(defn select-by-id [pan kw]
+  (let [tag (kw->idtag kw)]
+    (select pan [tag])))
+
+(defn get-e-val [e]
+  (value (.getSource e)))
+
+;;;;;;;;;;;;;; transforms start
+
+(defn translate-seq
+  ([n] #(translate-seq n %))
+  ([n seq]
+   (let [del (mod n (count seq))
+         head (take del seq)
+         tail (drop del seq)]
+     (concat tail head))))
+
+(defn reflect-seq
+  ([n] #(reflect-seq n %))
+  ([n seq]
+   (let [del (mod (+ n 1) (count seq))
+         trans (translate-seq del seq)]
+     (reverse trans))))
+
+(defn transform-dict [dict trans]
+  (let [kws (keys dict)
+        oldvals (vals dict)
+        newvals (trans oldvals)
+        pairs (map #(vector %1 %2) kws newvals)]
+    (into {} pairs)))
+
+(defn transform-necklace [trans id typekw]
+  (let [panel (id->panel id)
+        olddict (remove-circle id typekw false)
+        newdict (transform-dict olddict trans)
+        kwlist (keys newdict)]
+    (doseq [kw kwlist]
+        (value! (select panel [kw]) (get newdict kw)))))
+
+(defn make-transform-panel [id typekw]
+  (let [len (get-in @melody-map [id typekw])
+        typename (if (= typekw :beats)
+                   "-rhy-" "-mel-")
+        reflect-button (button :text "Reflect!"
+                               :listen [:action (fn [e]
+                                                  (transform-necklace
+                                                   (reflect-seq 0) id typekw))])
+        translabel (label "Translate: ")
+        transbox (combobox :model (range len)
+                           :id (keyword (s/join ["kb-" id typename "translate"]))
+                           :listen [:action (fn [e]
+                                           (transform-necklace
+                                                   (translate-seq (get-e-val e))
+                                                   id typekw))])]
+    (horizontal-panel :items [reflect-button translabel transbox])))
+
+;;;;;;;;;;;;;; transforms end
+
 (defn make-panel-controls [id]
   (let [cbp (combobox :model (range 1 10)
                       :id (keyword (s/join ["kb-" (str id) "-numpitch"]))
@@ -546,14 +625,17 @@
                  :listen [:window-closing
                           (fn [e]
                             (swap! melody-map dissoc id))])
-        verticalpanel (vertical-panel :items [pan chinstr playsolo controls])
         numcbs 1]
     (swap! melody-map assoc id {:pitches numcbs, :beats numcbs,
                                 :root f, :instr "Default"})
     (add-note-circles id pan)
-    (config! f :content verticalpanel)
-    (-> f pack! show!)
-    f))
+    (let [mel-controls (make-transform-panel id :pitches)
+          rhy-controls (make-transform-panel id :beats)
+          verticalpanel (vertical-panel :items [mel-controls pan rhy-controls
+                                                chinstr playsolo controls])]
+      (config! f :content verticalpanel)
+      (-> f pack! show!)
+      f)))

 (defn make-circles-hash [id]
   (let [root (get-in @melody-map [id :root])
@@ -685,9 +767,6 @@
                                             :text "Repeat?"
                                             :listen [:action repeat-action])
                                     repeat-label])
-                           (combobox :model instruments
-                                     :id :instChooser
-                                     :listen [:action inst-chooser])
                            (label "Instrument:")
                            (combobox :model instruments
                                      :id :instChooser


Gracefully handles nil watch objects (#1826)

* Gracefully handles nil watch objects

* Goes back an exception, but with more information


color bars and scroll text

color bars and scroll text

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -58,15 +58,16 @@
                                     "DUMMY"
                                     :weight 100
                                     :fill "#ffffff"))
-(defonce test-text (font/make-text "100 24px Indie Flower"
+(defonce test-text (font/make-text "500 24px Indie Flower"
                                     "-=retrogradeorbit=-\n"
-                                    :weight 100
-                                    :fill "#ff00ff"))
+                                    :weight 500
+                                    :fill "#ff00ff"
+                                    ;:stroke "#505050"
+                                    ;:strokeThickness 1
+                                    ))
 (defonce scroll-text
   (font/make-text "100 24px Indie Flower"
-                  ". .. ... This will eventually be the index page for my game jam submissions. \"Alien Forest Explorer\" from Global Game Jam, and \"Marty Funk\" and \"Monster Simulator?\" from ludum dare competitions. These HTML5 games were all developed with free and open source software on a linux platform. I use pixi.js as the underlying framework but target it through infinitelives.pixi using clojurescript. If you haven't tried clojure or clojurescript you should definitely try them. This of course wouldn't have been possible without the work of so many other people. Those involved in the creation of clojure and clojurescript, in pixi.js and in the many tools I use, like grafx2, impulse tracker and sfxr. Best wishes to everyone out there and enjoy! ...  .. .\n")
-
-)
+                  ". .. ... Old School Demo on a New School platform! This will eventually be the index page for my game jam submissions. \"Alien Forest Explorer\" from Global Game Jam 2015, and \"Marty Funk\" and \"Monster Simulator?\" from Ludum Dare 32 and 33. These HTML5 games were all developed with free and open source software on a linux platform. I use pixi.js as the underlying framework but target it through infinitelives.pixi using clojurescript. If you haven't tried clojure or clojurescript you should definitely try them. This of course wouldn't have been possible without the work of so many other people. Those involved in the creation of clojure and clojurescript, in pixi.js and in the many tools I use, like grafx2, impulse tracker and sfxr. A big shout out to the other farnarkler and to the Inversion crew. Best wishes to everyone out there and enjoy! ...  .. .\n"))

 ;;
 ;; font preloader channel
@@ -103,6 +104,13 @@
     return fract(sin(uv.x * 15.78 + uv.y * 35.14) * 43758.23);
 }

+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);
+}
+
 void main( void ) {
     vec4 col = texture2D(uSampler, vTextureCoord);

@@ -111,13 +119,18 @@
     float b=col.b;

     // magenta?
-    bool mag = ((r-b)<0.1) && r>0.1;
+    bool mag = ((r-b)<0.1) && r>0.1 && g<0.1;

     if(mag)
     {
          //gl_FragColor = vec4(vTextureCoord.x, vTextureCoord.y, 0.5, 1.0);
          float c = hash2(gl_FragCoord.xy * time);
-         gl_FragColor = vec4(c,c,c,1.0) * r;
+         gl_FragColor = vec4(hsv2rgb(vec3(4.0*vTextureCoord.y +
+                                     //(-2.0 * sin(0.04 * time)) +
+(-0.02 * time)
+,
+                                     1.0,
+                                     1.0)), 1.0) * r;
     }
     else
     {
@@ -130,7 +143,7 @@
     (go
       (loop [frame 0]
         (<! (events/next-frame))
-        (set! (.-uniforms.time.value f) (/ frame 1000))
+        (set! (.-uniforms.time.value f) (float frame))
         (recur (inc frame))))
     f))

@@ -161,7 +174,7 @@
     ;; bouncing name
     ;;
     (sprite/set-alpha! test-text 0.0)
-    (sprite/set-scale! test-text 6)
+    (sprite/set-scale! test-text 7)
     (set! (.-filters test-text) #js [(make-test)])
     (.addChild (-> canvas :layer :ui) test-text)
     (resources/fadein test-text :duration 5)
@@ -169,7 +182,8 @@
           (let [h (.-innerHeight js/window)
                 hh (/ h 2)
                 qh (/ h 4)]
-            (sprite/set-pos! test-text 0 (+ 200 (- (* 0.6 qh (Math/sin (* 0.04 n))) qh))
+            (sprite/set-pos! test-text 0 ;-200
+                                        (+ (* 0.5 qh) (- (* 0.1 qh (Math/sin (* 0.1 n))) qh))
                              ))
           (<! (events/next-frame))
           (recur (inc n))))
@@ -179,13 +193,13 @@
     ;;
     (sprite/set-scale! scroll-text 4)
     (.addChild (-> canvas :layer :ui) scroll-text)
-    (go (loop [n -3200]
+    (go (loop [n -3600]
           (let [h (.-innerHeight js/window)
                 hh (/ h 2)
                 qh (/ h 4)]
             (sprite/set-pos! scroll-text (* n -5) (- hh 80)))
           (<! (events/next-frame))
-          (recur (if (> n 3200) -3200 (inc n)))))
+          (recur (if (> n 3600) -3600 (inc n)))))

     ;;
     ;; parallax stars


minor alignment stuff

minor alignment stuff

--- src/lseq_tree/base.cljc
+++ src/lseq_tree/base.cljc
@@ -28,10 +28,10 @@
             diverge? (and common-root (not (== low-val up-val)))
             common-root (if diverge? false common-root)
             low-greater (if diverge? (> low-val up-val) low-greater)
-            up-val (if low-greater (- (pow 2 (bit base depth)) 1) up-val)
-            acc1  (+ acc (- up-val low-val (if (or common-root
-                                                     low-greater
-                                                     (not= depth level)) 0 1)))
+            up-val1 (if low-greater (dec (pow 2 (bit base depth))) up-val)
+            acc1  (+ acc (- up-val1 low-val (if (or common-root
+                                                    low-greater
+                                                    (not= depth level)) 0 1)))
             acc2 (if (not= depth level)
                    (* acc1 (pow 2 (bit base (+ depth 1))))
                    acc1)]


license information

license information

--- src/me/panzoo/story.clj
+++ src/me/panzoo/story.clj
@@ -13,9 +13,9 @@
  ; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  ;
  ;
- ; The cond-let function is under the following license:
+ ; cond-let, read-lines, and write-lines, are under the following license:
  ;
- ; Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
+ ; Copyright (c) Rich Hickey. All rights reserved.  The use and
  ; distribution terms for this software are covered by the Eclipse Public
  ; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
  ; be found in the file epl-v10.html at the root of this distribution.  By
@@ -24,6 +24,15 @@
  ; from this software.

 ; # The code
+;
+; The code is Copyright (c) Jeremy Hughes 2011 and is available under the
+; [ISC] license, except for the [[cond-let]],
+; [[read-lines]], and [[write-lines]] functions which are Copyright (c) Rich
+; Hickey and are under the [EPL]. These licenses are in the root of this source
+; distribution in the files `LICENSE` and `epl-v10.html`.
+;
+; [ISC]: http://en.wikipedia.org/wiki/ISC_license
+; [EPL]: http://www.eclipse.org/org/documents/epl-v10.php
 ;
 ; The usual stuff comes first. This code needs to read and write to files,
 ; manipulate strings, and parse Markdown.


added note in html.clj that a part should possibly become a template

--- src/noteServer/html.clj
+++ src/noteServer/html.clj
@@ -33,6 +33,8 @@
                                      :data-id item-id}
                                 text]))
                            data)
+                      ;; Possibly move the form to a template, both to save
+                      ;; bytes, and to only show it when js is active
                       [:li.new-item
                        [:form {:name "new-bullet"}
                         (text-field {:class "seamless" :placeholder "New bullet"} "text")


Comment out unnecessary code.

Comment out unnecessary code.

--- src/overtone/sc/bus.clj
+++ src/overtone/sc/bus.clj
@@ -116,9 +116,9 @@
   (dotimes [i AUDIO-BUS-RESERVE-COUNT]
     (audio-bus)))

-(defn reset-buses
-  [event-info]
-  nil)
+;; (defn reset-buses
+;;   [event-info]
+;;   nil)

 ;(on-sync-event :reset reset-buses ::reset-buses)


show ssh-info spinners while the build is setting up SSH access

--- frontend/models/build.cljs
+++ frontend/models/build.cljs
@@ -146,7 +146,8 @@
 (defn ssh-enabled-now? [build]
   (and (:ssh_enabled build)
        (:node build)
-       (every? :ssh_enabled (:node build))))
+       (or (running? build)
+           (every? :ssh_enabled (:node build)))))

 (defn display-build-invite [build]


Add smart action ui hints

Add smart action ui hints

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -465,6 +465,112 @@
           state
           (apply rw/adjacent-xys (rp/player-xy state))))

+(defn pickup-directions
+  [state]
+  (map second
+       (filter (fn [[cell direction]]
+                 (-> (get cell :items [])
+                     count
+                     pos?))
+               (map (fn [direction]
+                      [(rw/player-adjacent-cell state direction) direction])
+                    rc/directions-ext))))
+
+(defn harvestable-directions
+  [state]
+  (->> rc/directions-ext
+    (map (fn [direction]
+           [(rw/player-adjacent-cell state direction) direction]))
+    (filter (fn [[cell direction]]
+              (get cell :harvestable)))
+    (map second)))
+
+(defn openable-directions
+  [state]
+  (map second
+       (filter (fn [[cell direction]]
+                 (contains? #{:close-door} (get cell :type)))
+               (map (fn [direction]
+                      [(rw/player-adjacent-cell state direction) direction])
+                    rc/directions-ext))))
+
+(defn closeable-directions
+  [state]
+  (map second
+       (filter (fn [[cell direction]]
+                 (contains? #{:open-door} (get cell :type)))
+               (map (fn [direction]
+                      [(rw/player-adjacent-cell state direction) direction])
+                    rc/directions-ext))))
+
+(defn quaff-directions
+  [state]
+  (->> rc/directions-ext
+     (map (fn [direction]
+            [(rw/player-adjacent-cell state direction) direction]))
+     (filter (fn [[cell direction]]
+               (rw/type->water? (get cell :type))))
+    (map second)))
+
+(defn stairs-directions
+  [state]
+  (if (rw/player-on-stairs? state) [:center] []))
+
+(defn directions-to-actions
+  [state]
+  (let [pickup-directions (pickup-directions state)
+        _ (log/info "pickup directions" (vec pickup-directions))
+        harvest-directions (harvestable-directions state)
+        _ (log/info "harvest-directions" (vec harvest-directions))
+        open-directions (openable-directions state)
+        _ (log/info "open-directions" (vec open-directions))
+        close-directions (closeable-directions state)
+        _ (log/info "close-directions" (vec close-directions))
+        quaff-directions (quaff-directions state)
+        _ (log/info "quaff-directions" (vec quaff-directions))
+        stairs-directions (stairs-directions state)
+        _ (log/info "player-on-stairs?" stairs-directions)
+        actions (as-> [] actions
+                  (if (seq pickup-directions)
+                    (conj actions {:state-id :pickup
+                                   :name "Pickup"})
+                    actions)
+                  (if (seq harvest-directions)
+                    (conj actions {:state-id :harvest
+                                   :name "Harvest"})
+                    actions)
+                  (if (seq open-directions)
+                    (conj actions {:state-id :open
+                                   :name "Open"})
+                    actions)
+                  (if (seq close-directions)
+                    (conj actions {:state-id :close
+                                   :name "Close"})
+                    actions)
+                  (if (seq quaff-directions)
+                    (conj actions {:state-id :quaff
+                                   :name "Quaff"}
+                    actions))
+                  (if stairs-directions
+                    (conj actions {:state-id :stairs
+                                   :name "Stairs"})
+                    actions))
+        ;; direction->#{set of actions}
+        directions (reduce-kv (fn [directions action action-directions]
+                             (merge-with clojure.set/union directions (zipmap action-directions (repeat #{action}))))
+                           {}
+                           {:pickup  pickup-directions
+                            :harvest harvest-directions
+                            :open    open-directions
+                            :close   close-directions
+                            :quaff   quaff-directions
+                            :stairs  stairs-directions})]
+      (log/info "num pickup-directions" (count pickup-directions)
+                "num harvest-directions" (count harvest-directions)
+                "num open-directions" (count open-directions)
+                "num close-directions" (count close-directions))
+    directions))
+
 (defn move
   "Move the player one space provided her/she is able. Else do combat. Else swap positions
    with party member. Else hack something down."
@@ -478,6 +584,7 @@
         [target-x
          target-y] (rw/player-adjacent-xy state direction)
         target-cell (rw/get-cell state target-x target-y)]
+
     (log/info "moving to" target-x target-y "type:" (get target-cell :type))
     (log/info "inside-safe-zone?" (rv/xy-in-safe-zone? state target-x target-y) target-x target-y)
     (log/info "not collide?" (not (rw/collide? state target-x target-y {:include-npcs? false})))
@@ -508,6 +615,16 @@
                 (rw/assoc-current-state state :normal))
               (assoc-in state [:world :player :pos :x] target-x)
               (assoc-in state [:world :player :pos :y] target-y)
+              (cond-> state
+                (seq (directions-to-actions state))
+                  (rc/ui-hint (str (->> state
+                                     directions-to-actions
+                                     (mapcat second)
+                                     set
+                                     (map name)
+                                     (clojure.string/join ", ")
+                                     clojure.string/capitalize)
+                                     " (space).")))
               ; clear bloody status when moving into water
               (if (rw/type->water? (get target-cell :type))
                 (rp/assoc-bloodied state false)
@@ -980,17 +1097,6 @@
             (rw/assoc-current-state new-state :normal)
             new-state))
         state)))
-
-(defn pickup-directions
-  [state]
-  (map second
-       (filter (fn [[cell direction]]
-                 (-> (get cell :items [])
-                     count
-                     pos?))
-               (map (fn [direction]
-                      [(rw/player-adjacent-cell state direction) direction])
-                    rc/directions-ext))))

 (defn assoc-pickup-target
   [state direction]
@@ -1420,15 +1526,6 @@
       :else
         (rw/assoc-current-state state :pickup))))

-(defn harvestable-directions
-  [state]
-  (map second
-       (filter (fn [[cell direction]]
-                 (get cell :harvestable))
-               (map (fn [direction]
-                      [(rw/player-adjacent-cell state direction) direction])
-                    rc/directions-ext))))
-
 (defn smart-harvest
   [state]
   ;; If there is just one adjacent thing to harvest, just harvest it. Otherwise enter a harvest mode.
@@ -1445,14 +1542,6 @@
       :else
         (rw/assoc-current-state state :harvest))))

-(defn openable-directions
-  [state]
-  (map second
-       (filter (fn [[cell direction]]
-                 (contains? #{:close-door} (get cell :type)))
-               (map (fn [direction]
-                      [(rw/player-adjacent-cell state direction) direction])
-                    rc/directions-ext))))
 (defn smart-open
   [state]
   ;; If there is just one adjacent thing to open, just open it. Otherwise enter open mode.
@@ -1470,24 +1559,6 @@
       :else
         (rw/assoc-current-state state :open))))

-(defn closeable-directions
-  [state]
-  (map second
-       (filter (fn [[cell direction]]
-                 (contains? #{:open-door} (get cell :type)))
-               (map (fn [direction]
-                      [(rw/player-adjacent-cell state direction) direction])
-                    rc/directions-ext))))
-
-(defn quaff-directions
-  [state]
-  (->> rc/directions-ext
-     (map (fn [direction]
-            [(rw/player-adjacent-cell state direction) direction]))
-     (filter (fn [[cell direction]]
-               (rw/type->water? (get cell :type))))
-    (map second)))
-
 (defn smart-close
   [state]
   ;; If there is just one adjacent thing to close, just close it. Otherwise enter close mode.
@@ -1503,61 +1574,6 @@
           (rw/assoc-current-state :normal))
       :else
         (rw/assoc-current-state state :close))))
-
-(defn directions-to-actions
-  [state]
-  (let [pickup-directions (pickup-directions state)
-        _ (log/info "pickup directions" (vec pickup-directions))
-        harvest-directions (harvestable-directions state)
-        _ (log/info "harvest-directions" (vec harvest-directions))
-        open-directions (openable-directions state)
-        _ (log/info "open-directions" (vec open-directions))
-        close-directions (closeable-directions state)
-        _ (log/info "close-directions" (vec close-directions))
-        quaff-directions (quaff-directions state)
-        _ (log/info "quaff-directions" (vec quaff-directions))
-        stairs-directions (if (rw/player-on-stairs? state) [:center] [])
-        _ (log/info "player-on-stairs?" stairs-directions)
-        actions (as-> [] actions
-                  (if (seq pickup-directions)
-                    (conj actions {:state-id :pickup
-                                   :name "Pickup"})
-                    actions)
-                  (if (seq harvest-directions)
-                    (conj actions {:state-id :harvest
-                                   :name "Harvest"})
-                    actions)
-                  (if (seq open-directions)
-                    (conj actions {:state-id :open
-                                   :name "Open"})
-                    actions)
-                  (if (seq close-directions)
-                    (conj actions {:state-id :close
-                                   :name "Close"})
-                    actions)
-                  (if (seq quaff-directions)
-                    (conj actions {:state-id :quaff
-                                   :name "Quaff"}
-                    actions))
-                  (if stairs-directions
-                    (conj actions {:state-id :stairs
-                                   :name "Stairs"})
-                    actions))
-        ;; direction->#{set of actions}
-        directions (reduce-kv (fn [directions action action-directions]
-                             (merge-with clojure.set/union directions (zipmap action-directions (repeat #{action}))))
-                           {}
-                           {:pickup  pickup-directions
-                            :harvest harvest-directions
-                            :open    open-directions
-                            :close   close-directions
-                            :quaff   quaff-directions
-                            :stairs  stairs-directions})]
-      (log/info "num pickup-directions" (count pickup-directions)
-                "num harvest-directions" (count harvest-directions)
-                "num open-directions" (count open-directions)
-                "num close-directions" (count close-directions))
-    directions))

 (defn direction->unicode-char
   [direction]


use defendpoint

use defendpoint

--- src/metabase/api/qs.clj
+++ src/metabase/api/qs.clj
@@ -28,13 +28,9 @@
     (driver/dataset-query dataset-query options)))

-;; TODO - not using defendpoint due to string params causing number format exceptions
-(def query-result
-  (GET "/:uuid" [uuid]
-    (let-404 [query-execution (eval `(sel :one ~all-fields :uuid ~uuid))]
-      (->>
-        (build-response query-execution)
-        (assoc {:status 200} :body)))))
+(defendpoint GET "/:uuid" [uuid]
+  (let-404 [query-execution (eval `(sel :one ~all-fields :uuid ~uuid))]
+    (build-response query-execution)))

 (def query-result-csv


log requests to request log only

log requests to request log only

--- src/shelver/handler.clj
+++ src/shelver/handler.clj
@@ -9,7 +9,8 @@
 (defn wrap-log-request [handler]
   (fn [req]
     (timbre/with-merged-config
-      {:appenders {:request (appenders/spit-appender {:fname "request.log"})}}
+      {:appenders {:request (appenders/spit-appender {:fname "request.log"})
+                   :println {:enabled? false}}}
       (timbre/info req))
     (handler req)))


Exercise 2.42

Exercise 2.42

--- src/sicp/chapter2_2.clj
+++ src/sicp/chapter2_2.clj
@@ -68,4 +68,41 @@

 ;;; 2.2.3  Sequences as Conventional Interfaces

+;; Exercise 2.42
+(defn queens [board-size]
+  (let [pos (fn [r c]
+              [r c])
+        row-pos (fn [p]
+                  (first p))
+        column-pos (fn [p]
+                     (second p))
+        empty-board []
+        safe? (fn [k positions]
+                (let [[k-position & rest-positions] positions
+                      k-row (row-pos k-position)
+                      k-column (column-pos k-position)]
+                  (not-any? (fn [position]
+                              (let [row (row-pos position)
+                                    column (column-pos position)
+                                    row-diff (- k-row row)
+                                    column-diff (- k-column column)]
+                                (or (zero? row-diff)
+                                    (zero? column-diff)
+                                    (= (Math/abs row-diff) (Math/abs column-diff)))))
+                            rest-positions)))
+        adjoin-position (fn [new-row k rest-of-queens]
+                          (cons (pos new-row k) rest-of-queens))
+        queen-cols (fn queen-cols [k]
+                     (if (zero? k)
+                       [empty-board]
+                       (filter
+                        (fn [positions] (safe? k positions))
+                        (mapcat
+                         (fn [rest-of-queens]
+                           (map (fn [new-row]
+                                  (adjoin-position new-row k rest-of-queens))
+                                (range 1 (inc board-size))))
+                         (queen-cols (dec k))))))]
+    (queen-cols board-size)))
+
 ;;; 2.2.4  Example: A Picture Language


more tinkering with formats

more tinkering with formats

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -1,19 +1,11 @@
-(ns ontrail.summary)
+(ns ontrail.summary
+  (:use ontrail.mongodb ontrail.formats))

 (require '[monger.core]
          '[monger.conversion]
          '[clj-time.core :as time]
          '[monger.joda-time]
          '[monger.collection :as mc])
-
-(use 'ontrail.mongodb)
-(use 'ontrail.formats)
-
-(defn pace [db-retmap]
-  (let [distance (get db-retmap :tdist)]
-    (if (> distance 0)
-      (/ (/ (get db-retmap :tdur) 6000) (/ distance 1000))
-      0)))

 (defn avghr [db-retmap]
   (let [hrcount (get db-retmap :hrcount)]
@@ -23,10 +15,12 @@

 (defn to-summary [db-object sport]
   (let [db-retmap (first (get db-object :retval))
-        count (int (get db-object :count))]
-    {:duration (to-human-time (int (get db-retmap :dur)))
-     :distance (to-human-distance (int (get db-retmap :dist)))
-     :pace (to-human-pace (pace db-retmap))
+        count (int (get db-object :count))
+        true-duration (get db-retmap :tdur)
+        true-distance (get db-retmap :tdist)]
+    {:duration (to-human-time (get db-retmap :tdur))
+     :distance (to-human-distance (get db-retmap :tdist))
+     :pace (get-pace {:sport sport :duration true-duration :distance true-distance})
      :avghr (avghr db-retmap)
      :count count
      :sport sport}))


Add helper fns to get event states and set colour

--- src/riemann/hipchat.clj
+++ src/riemann/hipchat.clj
@@ -3,6 +3,25 @@
   riemann.hipchat
   (:require [clj-http.client :as client]
             [cheshire.core :as json]))
+
+(defn- get-state [ev]
+  "Gets the state from an event"
+  (:state ev))
+
+(defn- get-nested-state [ev]
+  "Gets the state from the first event
+  in a vector."
+  (:state (first ev)))
+
+(defn- set-message-colour [ev]
+  "Set the colour to be used in the
+  hipchat message."
+  (let [state (if-let [s (get-state ev)] s (get-nested-state ev))]
+    (condp = state
+      "ok"        "green"
+      "critical"  "red"
+      "error"     "red"
+      "yellow")))

 (def ^:private chat-url
   "https://api.hipchat.com/v1/rooms/message?format=json")
@@ -14,11 +33,8 @@
        ",\nmetric: " metric))

 (defn- format-event [{:keys [room_id from notify message] :as conf} event]
-  (merge {:color (condp = (:state event)
-                   "ok"       "green"
-                   "critical" "red"
-                   "error"    "red"
-                   "yellow")}
+  "Creates an event suitable for posting to hipchat."
+  (merge {:color (set-message-colour event)}
          conf
          (when-not message
            {:message (format-message event)})))


Ensure that comments are handled properly when calculating the line number of a statement.

--- src/sql_file/script.clj
+++ src/sql_file/script.clj
@@ -75,32 +75,35 @@

 (defn sql-read-statement [ in ]
   (sql-skip-whitespace in)
-  (let [ stmt (get-input-location in) ]
-    (loop [stmt-buf (StringBuffer.)]
-      (case (rdr/peek-char in)
-        \-
-        (do
+  (loop [stmt-buf (StringBuffer.)
+         loc nil]
+    (case (rdr/peek-char in)
+      \-
+      (do
+        (let [ comment-loc (get-input-location in) ]
           (rdr/read-char in)
           (if (optional-char in \-)
             (do
               (sql-skip-comment in)
-              (recur stmt-buf))
-            (recur (.append stmt-buf \-))))
-
-        (nil \;)
-        (do
-          (rdr/read-char in)
-          (if (> (.length stmt-buf) 0)
-            (assoc stmt :statement (.toString stmt-buf))
-            nil))
+              (recur stmt-buf loc))
+            (recur (.append stmt-buf \-) (or loc comment-loc)))))
+
+      (nil \;)
+      (do
+        (rdr/read-char in)
+        (if (> (.length stmt-buf) 0)
+          (assoc loc :statement (.toString stmt-buf))
+          nil))
+
+      \'
+      (let [ str-loc (get-input-location in) ]
+        (recur (.append stmt-buf (sql-read-string in)) (or loc str-loc)))

-        \'
-        (recur (.append stmt-buf (sql-read-string in)))
-
-        (let [ ch (rdr/read-char in) ]
-          (if (Character/isWhitespace ch)
-            (recur (ensure-whitespace stmt-buf))
-            (recur (.append stmt-buf ch))))))))
+      (let [ch-loc (get-input-location in)
+            ch (rdr/read-char in) ]
+        (if (Character/isWhitespace ch)
+          (recur (ensure-whitespace stmt-buf) loc)
+          (recur (.append stmt-buf ch) (or loc ch-loc)))))))

 (defn sql-statements [ sql ]
   "Given a sequence of characters corresponding to a SQL script,


Misc hk

Misc hk

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -51,7 +51,7 @@
 (def ^bytes bs-bin (bytestring "\u0000<")) ; Binary data marker
 (def ^bytes bs-clj (bytestring "\u0000>")) ; Frozen data marker

-(defn- assert-reserved-first-byte [^bytes ba]
+(defn- ensure-reserved-first-byte [^bytes ba]
   (when (zero? (aget ba 0))
     (throw (Exception. (str "Args can't begin with null terminator"))))
   ba)
@@ -66,9 +66,9 @@

 (extend-protocol IRedisArg
   String  (coerce-bs [x] (-> (bytestring x)
-                             (assert-reserved-first-byte)))
+                             (ensure-reserved-first-byte)))
   Keyword (coerce-bs [x] (-> (bytestring ^String (encore/fq-name x))
-                             (assert-reserved-first-byte)))
+                             (ensure-reserved-first-byte)))

   ;;; Simple number types (Redis understands these)
   Long    (coerce-bs [x] (bytestring (str x)))


Simplify projects events.

Simplify projects events.

--- src/uxbox/main/data/projects.cljs
+++ src/uxbox/main/data/projects.cljs
@@ -16,12 +16,31 @@
             [uxbox.util.schema :as sc]
             [uxbox.main.data.pages :as udp]))

+;; --- Helpers
+
+(defn assoc-project
+  "A reduce function for assoc the project
+  to the state map."
+  [state proj]
+  (let [id (:id proj)]
+    (update-in state [:projects-by-id id] merge proj)))
+
+(defn dissoc-project
+  "A reduce function for dissoc the project
+  from the state map."
+  [state id]
+  (update-in state [:projects-by-id] dissoc id))
+
 ;; --- Initialize

 (declare fetch-projects)
 (declare projects-fetched?)

 (defrecord Initialize []
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (assoc-in state [:dashboard :section] :dashboard/projects))
+
   rs/EffectEvent
   (-apply-effect [_ state]
     (when-not (seq (:projects-by-id state))
@@ -44,8 +63,6 @@
   (Initialize.))

 ;; --- Projects Fetched
-
-(declare assoc-project)

 (defrecord ProjectsFetched [projects]
   rs/UpdateEvent
@@ -114,8 +131,6 @@

 ;; --- Delete Project (by id)

-(declare dissoc-project)
-
 (defrecord DeleteProject [id]
   rs/WatchEvent
   (-apply-watch [_ state s]
@@ -166,58 +181,15 @@
   ([projectid] (GoTo. projectid))
   ([projectid pageid] (GoToPage. projectid pageid)))

-;; --- UI related events
+;; --- Update Opts (Filtering & Ordering)

-(defn set-project-ordering
-  [order]
-  (reify
-    rs/UpdateEvent
-    (-apply-update [_ state]
-      (assoc-in state [:dashboard :project-order] order))))
+(defrecord UpdateOpts [order filter]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (update-in state [:dashboard :projects] merge
+               (when order {:order order})
+               (when filter {:filter filter}))))

-(defn set-project-filtering
-  [term]
-  (reify
-    rs/WatchEvent
-    (-apply-watch [_ state s]
-      (assoc-in state [:dashboard :project-filter] term))))
-
-(defn clear-project-filtering
-  []
-  (reify
-    rs/UpdateEvent
-    (-apply-update [_ state]
-      (assoc-in state [:dashboard :project-filter] ""))))
-
-;; --- Helpers
-
-(defn sort-projects-by
-  [ordering projs]
-  (case ordering
-    :name (sort-by :name projs)
-    :created (reverse (sort-by :created-at projs))
-    projs))
-
-(defn contains-term?
-  [phrase term]
-  (str/contains? (str/lower phrase) (str/trim (str/lower term))))
-
-(defn filter-projects-by
-  [term projs]
-  (if (str/blank? term)
-    projs
-    (filter #(contains-term? (:name %) term) projs)))
-
-(defn assoc-project
-  "A reduce function for assoc the project
-  to the state map."
-  [state proj]
-  (let [id (:id proj)]
-    (update-in state [:projects-by-id id] merge proj)))
-
-(defn dissoc-project
-  "A reduce function for dissoc the project
-  from the state map."
-  [state id]
-  (update-in state [:projects-by-id] dissoc id))
-
+(defn update-opts
+  [& {:keys [order filter] :as opts}]
+  (UpdateOpts. order filter))


pass in missing arg

pass in missing arg

--- src/wombats/daos/game.clj
+++ src/wombats/daos/game.clj
@@ -1,5 +1,6 @@
 (ns wombats.daos.game
   (:require [datomic.api :as d]
+            [taoensso.timbre :as log]
             [taoensso.nippy :as nippy]
             [wombats.constants :refer [initial-stats]]
             [wombats.game.core :as game]
@@ -243,13 +244,16 @@

       ;; We put this in a future so that it gets run on a separate thread
       (future
-        (game/start-round game-state
-                          {:update-frame (update-frame-state conn)
-                           :close-round (close-round conn)
-                           :close-game (close-game-state conn)
-                           :round-start-fn (start-game conn aws-credentials)}
-                          aws-credentials
-                          lambda-settings))
+        (try
+          (game/start-round game-state
+                            {:update-frame (update-frame-state conn)
+                             :close-round (close-round conn)
+                             :close-game (close-game-state conn)
+                             :round-start-fn (start-game conn aws-credentials lambda-settings)}
+                            aws-credentials
+                            lambda-settings)
+          (catch Exception e
+            (log/error e))))

       (d/transact-async conn [{:game/id game-id
                                :game/status :active}]))))


removed :with-precision from push.type.definitions.tagspace/make-tagspace

--- src/push/type/definitions/tagspace.clj
+++ src/push/type/definitions/tagspace.clj
@@ -9,7 +9,7 @@
 (defn make-tagspace
   "Creates a new empty tagspace"
   ([] (->TagSpace (sorted-map)))
-  ([starting-items] (->TagSpace (with-precision 100 (into (sorted-map) starting-items)))))
+  ([starting-items] (->TagSpace (into (sorted-map) starting-items))))

 (defn tagspace?


Use :block? for tests table creation

Use :block? for tests table creation

--- test/taoensso/faraday/tests/main.clj
+++ test/taoensso/faraday/tests/main.clj
@@ -14,16 +14,12 @@

 (defn- setup {:expectations-options :before-run} []
   (println "Setting up testing environment...")
-
-  (when (or (far/ensure-table creds
-              {:name        ttable
-               :hash-keydef {:name :id :type :n}
-               :throughput  {:read 1 :write 1}}))
-    (println "Sleeping 90s for table creation (only need to do this once!)...")
-    (Thread/sleep 45000)
-    (println "45s left...")
-    (Thread/sleep 45000)
-    (println "Ready to roll...")))
+  (far/ensure-table creds
+    {:name        ttable
+     :hash-keydef {:name :id :type :n}
+     :throughput  {:read 1 :write 1}
+     :block?      true})
+  (println "Ready to roll..."))

 (comment (far/delete-table creds ttable))


Switch test to fixed window which supports ordered log.

--- test/onyx/health_test.clj
+++ test/onyx/health_test.clj
@@ -85,11 +85,10 @@
 	    windows
 	    [{:window/id window-id
 	      :window/task :my/inc
-              :window/type :sliding
+              :window/type :fixed
               :window/window-key :event-time
               :window/storage-strategy [:incremental :ordered-log]
               :window/range [5 :minutes]
-              :window/slide [1 :minutes]
 	      :window/aggregation :onyx.windowing.aggregation/count}]

 	    workflow [[:in :my/inc] [:my/inc :out]]


CMR-2133 Fixes some tests

CMR-2133 Fixes some tests

--- access-control-app/int_test/cmr/access_control/int_test/access_control_group_acl_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/access_control_group_acl_test.clj
@@ -24,7 +24,7 @@
           token (e/login (u/conn-context) "user2")
           response (u/create-group token group)]
       (is (= {:status 401
-              :errors ["You do not have permission to create system-level access control groups."]}
+              :errors ["You do not have permission to create system-level access control group [Administrators]."]}
              response)))))

 (deftest create-provider-group-test
@@ -71,7 +71,7 @@

       (testing "without permission"
         (is (= {:status 401
-                :errors ["You do not have permission to read system-level access control groups."]}
+                :errors ["You do not have permission to read system-level access control group [Administrators]."]}
                (u/get-group no-group-token system-group-concept-id)))))

     (testing "reading provider groups"
@@ -112,7 +112,7 @@
     (testing "deleting system groups"
       (testing "without permission"
         (is (= {:status 401
-                :errors ["You do not have permission to delete system-level access control groups."]}
+                :errors ["You do not have permission to delete system-level access control group [Administrators]."]}
                (u/delete-group prov-token sys-group-id))))

       (testing "with permission"
@@ -160,7 +160,7 @@
     (testing "updating system groups"
       (testing "without permission"
         (is (= {:status 401
-                :errors ["You do not have permission to update system-level access control groups."]}
+                :errors ["You do not have permission to update system-level access control group [Administrators]."]}
                (u/update-group prov-token sys-group-id (assoc sys-group :description "Updated name")))))

       (testing "with permission"
@@ -183,11 +183,11 @@
 (deftest group-members-acl-test

   ;; members of "sys-group" can create system-level groups and delete the group with the guid "sys-group-guid"
-  (e/grant-system-group-permissions-to-group (u/conn-context) "sys-group" :create)
-  (e/grant-group-instance-permissions-to-group (u/conn-context) "sys-group" "sys-group-guid" :update :read)
+  (e/grant-system-group-permissions-to-group (u/conn-context) "sys-group" :create :read)
+  (e/grant-group-instance-permissions-to-group (u/conn-context) "sys-group" "sys-group-guid" :update)
   ;; members of "prov1-group" can create groups for PROV1 but can only update the group with guid "prov1-group-guid"
-  (e/grant-provider-group-permissions-to-group (u/conn-context) "prov1-group" "prov1guid" :create)
-  (e/grant-group-instance-permissions-to-group (u/conn-context) "prov1-group" "prov1-group-guid" :update :read)
+  (e/grant-provider-group-permissions-to-group (u/conn-context) "prov1-group" "prov1guid" :create :read)
+  (e/grant-group-instance-permissions-to-group (u/conn-context) "prov1-group" "prov1-group-guid" :update)

   (let [sys-token (e/login (u/conn-context) "sys-user" ["sys-group"])
         sys-group (u/make-group {:legacy-guid "sys-group-guid"})
@@ -203,7 +203,7 @@
                (u/get-members prov1-token sys-group-concept-id)))
         (is (= {:status 401
                 :errors ["You do not have permission to read access control group [Administrators] in provider [PROV1]."]}
-               (u/get-members sys-token prov1-group-concept-id))))
+               (u/get-members (e/login (u/conn-context) "some-random-user") prov1-group-concept-id))))
       (testing "with permission"
         (is (= {:status 200 :body []}
                (u/get-members sys-token sys-group-concept-id)))


[CS] Remove errant comment

[CS] Remove errant comment

--- src/vip/data_processor/db/postgres.clj
+++ src/vip/data_processor/db/postgres.clj
@@ -7,7 +7,6 @@
   (let [{:keys [host port user password]} (config :postgres)]
     (str "jdbc:postgresql://" host ":" port "/?user=" user "&password=" password)))

-;;; then, actual migrations
 (defn migrate []
   (j/migrate-db {:db {:type :sql
                       :url (url)}


basic event and row processing

basic event and row processing

--- src/irmgard/core.clj
+++ src/irmgard/core.clj
@@ -5,6 +5,9 @@
    [clojure.tools.logging :as log])
   (:import
    [java.sql Connection DriverManager]))
+
+
+;; See:   "http://jdbc.postgresql.org/documentation/91/listennotify.html"

 (defonce registry         (atom {}))
 (defonce indexed-registry (atom {}))
@@ -55,10 +58,31 @@
    :password    (c :password)
    :port        (c :port)})

-(defn dispatch-notifications [dbname notifications]
-  (when (not (nil? notifications))
-    (log/infof "dispatch-notifications[%s]: %s notifications" dbname (count notifications)))
-  )
+(defn process-row-changes [conf conn]
+  ;; obtain mutex, nowait
+  (let [dbname        (-> conf :dbconf :subname)]
+   (jdbc/transaction
+    (jdbc/do-commands "LOCK TABLE irmgard.process_log IN EXCLUSIVE MODE NOWAIT")
+    (log/infof "obtained EXCLUSIVE lock on irmgard.process_log")
+    ;; select and process the first block of records
+    ;; TODO: make the LIMIT configurable
+    (loop [recs (exec-sql "SELECT * FROM irmgard.row_changes ORDER BY event_id LIMIT 100" [])]
+      (when (not (empty? recs))
+        (doseq [rec recs]
+          (doseq [[observer-name observer-fn] (find-listeners dbname (:schema_name rec) (:table_name rec))]
+            (observer-fn rec))
+          (jdbc/do-prepared "DELETE FROM irmgard.row_changes WHERE event_id=?" [(:event_id rec)]))
+        (recur (exec-sql "SELECT * FROM irmgard.row_changes ORDER BY event_id LIMIT 100" []))))
+    :ok)))
+
+(defn dispatch-notifications [conf conn]
+  ;; this select is purely for side-effect
+  (exec-sql "SELECT 1" [])
+  (let [dbname        (-> conf :dbname :subname)
+        notifications (.getNotifications conn)]
+    (when (not (nil? notifications))
+      (log/infof "dispatch-notifications[%s]: %s notifications" dbname (count notifications))
+      (process-row-changes conf conn))))

 (defn config->jdbc-url [c]
   (format "jdbc:postgresql://%s:%s/%s"
@@ -79,10 +103,8 @@
              continue @(:continue conf)]
         (if continue
           (do
-            ;; purely for side-effect
             (log/infof "db-watcher[%s] polling" dbname)
-            (exec-sql "SELECT 1" [])
-            (dispatch-notifications dbname (.getNotifications conn))
+            (dispatch-notifications conf conn)
             (try
              (Thread/sleep sleep-time)
              (catch Exception e
@@ -157,51 +179,21 @@
     (DriverManager/getConnection url (:username c) (:password c))))

 (comment
-  #_(with-open [conn (connect-to-db (config :db))]
-      (jdbc/with-connection {:conn conn}
-        (exec-sql "SELECT now()" [])))
-
   (start-watcher :test1 (db-conn-info (config :db)))
   (stop-watcher :test1)

-  @db-watchers

   (jdbc/with-connection  (db-conn-info (config :db))
     (exec-sql "SELECT now()" []))

-  "http://jdbc.postgresql.org/documentation/91/listennotify.html"
+  (register-listener :test-listener (:database (config :db)) "irmgard" "example_table"
+                     (fn [r]
+                       (log/infof "ROW CHANGE! %s" r)))

-
-  (def keep-running (atom true))
-  (reset! keep-running false)
-
-  (def nlist (atom []))
-  (class @nlist)
-  (first @nlist)
-
-  (map (fn [n]
-         {:name      (.getName n)
-          :parameter (.getParameter n)}) @nlist)
-
-  ;; NB: needs to be in a background thread...
-  (jdbc/with-connection (db-conn-info (config :db))
-    (jdbc/do-commands "LISTEN irmgard")
-    (loop [continue @keep-running]
-      ;;;
-      (exec-sql "SELECT 1" [])
-      (let [notifications (.getNotifications (jdbc/find-connection))]
-        (println (format "Found %s notifications" (count notifications)))
-        (swap! nlist (fn [curr & args]
-                       (vec (apply concat curr args)))
-               notifications))
-      (if continue
-        (do
-          (Thread/sleep 1000)
-          (recur @keep-running))
-        (println "terminating")))
-    ;; NB: this has to be in a finally block or it pollutes the connection
-    ;; instead, irmgard clients should not use a connection pool(!)
-    (jdbc/do-commands "UNLISTEN irmgard"))
+  (jdbc/with-connection  (db-conn-info (config :db))
+    (process-row-changes
+     {:dbconf (db-conn-info (config :db))}
+     (jdbc/find-connection)))

   )


test idea

test idea

--- test/clojure_fabric/core_test.clj
+++ test/clojure_fabric/core_test.clj
@@ -186,6 +186,7 @@
 (expect clojure_fabric.core.Channel
         (let [user (core/get-user "Org1MSP" "user1")]
           (user/get-channel user "mychannel")))
+
 (expect clojure_fabric.core.Channel
         (let [user (core/get-user "Org2MSP" "user1")]
           (user/get-channel user "mychannel")))
@@ -260,6 +261,18 @@
                           (= 200)))
                     (concat (channel/join-channel (user/get-channel org1-admin channel-name) org1-peers genesis-block)
                             (channel/join-channel (user/get-channel org2-admin channel-name) org2-peers genesis-block))))))
+
+#_
+(expect true
+        (let [admin (core/get-user "Org2MSP" "admin")
+              peer (first (core/get-nodes admin :peers))
+              chan (get-in (user/query-channels admin peer) [0 0])
+              chaincodes1 (user/query-installed-chaincodes admin peer)]
+          (user/install-chaincode admin (str "test" (System/currentTimeMillis)) "github.com/example_cc" "v1"
+                                  "/home/jc/Work/clojure-fabric/resources/gocc/src/github.com"
+                                  :golang [peer])
+          (= (inc (count chaincodes1))
+             (count (user/query-installed-chaincodes admin peer)))))
 #_
 (expect true
         (let [org1-admin (core/get-user "Org1MSP" "admin")


tests down to one error left

tests down to one error left

--- test/gamma/test/constructors.cljs
+++ test/gamma/test/constructors.cljs
@@ -13,11 +13,10 @@

 ;; test variables, declarations, literals

-
-(->glsl (gamma.ast/literal {:tag :variable :name "v" :type :vec4}))
-
-(def vec4-variable {:tag :variable :id "v" :type :vec4})
-;; operators
+;; FIXME make these actual tests?
+;; (->glsl (gamma.ast/literal {:tag :variable :name "v" :type :vec4}))
+;;
+;; (def vec4-variable {:tag :variable :id "v" :type :vec4})

 ;;;;;;; OPERATORS WITH VARIABLES

@@ -55,9 +54,7 @@
     (is (= (->glsl (g/xor b b)) "(b^^b);"))
     (is (= (->glsl (g/not b)) "(!b);"))))

-(operators)
-
-;; need swizzle tests
+;; FIXME need swizzle tests

 (deftest
   variables
@@ -94,7 +91,9 @@
         v2 {:tag :variable :name "v2" :type :vec2}
         v3 {:tag :variable :name "v3" :type :vec3}
         v4 {:tag :variable :name "v4" :type :vec4}
-        sampler {:tag :variable :id "sampler" :type :sampler2D}]
+        sampler2 {:tag :variable :name "sampler2" :type :sampler2D}
+        samplerC {:tag :variable :name "samplerC" :type :samplerCube}
+        ]
     (is (= (->glsl (g/radians t)) "radians(t);"))
     (is (= (->glsl (g/degrees t)) "degrees(t);"))
     (is (= (->glsl (g/sin t)) "sin(t);"))
@@ -140,15 +139,15 @@
     (is (= (->glsl (g/faceforward t t t)) "faceforward(t,t,t);"))
     (is (= (->glsl (g/reflect t t)) "reflect(t,t);"))
     (is (= (->glsl (g/refract t t f)) "refract(t,t,f);"))
-    (is (= (->glsl (g/texture2DLod sampler v2 f)) "texture2DLod(sampler,v2,f);"))
-    (is (= (->glsl (g/texture2DProjLod sampler v3 f)) "texture2DProjLod(sampler,v3,f);"))
-    (is (= (->glsl (g/texture2DProjLod sampler v4 f)) "texture2DProjLod(sampler,v4,f);"))
-    (is (= (->glsl (g/textureCubeLod sampler v4 f)) "textureCubeLod(sampler,v4,f);"))
-    (is (= (->glsl (g/texture2D sampler v2 f)) "texture2D(sampler,v2,f);"))
-    (is (= (->glsl (g/texture2DProj sampler v3 f)) "texture2DProj(sampler,v3,f);"))
-    (is (= (->glsl (g/texture2DProj sampler v4 f)) "texture2DProj(sampler,v4,f);"))
-    (is (= (->glsl (g/textureCube sampler v3 f)) "textureCube(sampler,v3,f);"))
-    (is (= (->glsl (g/texture2D sampler v2)) "texture2D(sampler,v2);"))
-    (is (= (->glsl (g/texture2DProj sampler v3 f)) "texture2DProj(sampler,v3,f);"))
-    (is (= (->glsl (g/texture2DProj sampler v4 f)) "texture2DProj(sampler,v4,f);"))
-    (is (= (->glsl (g/textureCube sampler v3)) "textureCube(sampler,v3);"))))
+    (is (= (->glsl (g/texture2DLod sampler2 v2 f)) "texture2DLod(sampler2,v2,f);"))
+    (is (= (->glsl (g/texture2DProjLod sampler2 v3 f)) "texture2DProjLod(sampler2,v3,f);"))
+    (is (= (->glsl (g/texture2DProjLod sampler2 v4 f)) "texture2DProjLod(sampler2,v4,f);"))
+    (is (= (->glsl (g/textureCubeLod samplerC v3 f)) "textureCubeLod(samplerC,v3,f);"))
+    (is (= (->glsl (g/texture2D sampler2 v2 f)) "texture2D(sampler2,v2,f);"))
+    (is (= (->glsl (g/texture2DProj sampler2 v3 f)) "texture2DProj(sampler2,v3,f);"))
+    (is (= (->glsl (g/texture2DProj sampler2 v4 f)) "texture2DProj(sampler2,v4,f);"))
+    (is (= (->glsl (g/textureCube samplerC v3 f)) "textureCube(samplerC,v3,f);"))
+    (is (= (->glsl (g/texture2D sampler2 v2)) "texture2D(sampler2,v2);"))
+    (is (= (->glsl (g/texture2DProj sampler2 v3 f)) "texture2DProj(sampler2,v3,f);"))
+    (is (= (->glsl (g/texture2DProj sampler2 v4 f)) "texture2DProj(sampler2,v4,f);"))
+    (is (= (->glsl (g/textureCube samplerC v3)) "textureCube(samplerC,v3);"))))


:produces and :consumes can be overridden

--- modules/reitit-middleware/src/reitit/ring/middleware/muuntaja.clj
+++ modules/reitit-middleware/src/reitit/ring/middleware/muuntaja.clj
@@ -6,13 +6,15 @@
 (s/def ::muuntaja (partial instance? m/Muuntaja))
 (s/def ::spec (s/keys :opt-un [::muuntaja]))

+(defn- displace [x] (with-meta x {:displace true}))
+
 (def format-middleware
   {:name ::format
    :spec ::spec
    :compile (fn [{:keys [muuntaja]} _]
               (if muuntaja
-                {:data {:swagger {:produces (m/encodes muuntaja)
-                                  :consumes (m/decodes muuntaja)}}
+                {:data {:swagger {:produces (displace (m/encodes muuntaja))
+                                  :consumes (displace (m/decodes muuntaja))}}
                  :wrap #(muuntaja.middleware/wrap-format % muuntaja)}))})

 (def format-negotiate-middleware
@@ -27,7 +29,7 @@
    :spec ::spec
    :compile (fn [{:keys [muuntaja]} _]
               (if muuntaja
-                {:data {:swagger {:consumes (m/decodes muuntaja)}}
+                {:data {:swagger {:consumes (displace (m/decodes muuntaja))}}
                  :wrap #(muuntaja.middleware/wrap-format-request % muuntaja)}))})

 (def format-response-middleware
@@ -35,5 +37,5 @@
    :spec ::spec
    :compile (fn [{:keys [muuntaja]} _]
               (if muuntaja
-                {:data {:swagger {:produces (m/encodes muuntaja)}}
+                {:data {:swagger {:produces (displace (m/encodes muuntaja))}}
                  :wrap #(muuntaja.middleware/wrap-format-response % muuntaja)}))})


CMR-4176: Clean up requires

CMR-4176: Clean up requires

--- metadata-db-app/src/migrations/053_remove_provider_services_tables.clj
+++ metadata-db-app/src/migrations/053_remove_provider_services_tables.clj
@@ -1,8 +1,8 @@
 (ns migrations.053-remove-provider-services-tables
-  (:require [clojure.java.jdbc :as j]
-            [config.migrate-config :as config]
-            [config.mdb-migrate-helper :as h]
-            [cmr.metadata-db.data.oracle.concept-tables :as ct]))
+  (:require
+    [cmr.metadata-db.data.oracle.concept-tables :as ct]
+    [config.mdb-migrate-helper :as h]
+    [config.migrate-config :as config]))

 (defn up
   "Migrates the database up to version 53."


CMR-4058: Simplified collection_spatialkeyword_keyword_search_test.clj

--- system-int-test/test/cmr/system_int_test/search/collection_spatialkeyword_keyword_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_spatialkeyword_keyword_search_test.clj
@@ -9,164 +9,25 @@
     [cmr.system-int-test.data2.core :as d]
     [cmr.system-int-test.utils.index-util :as index]
     [cmr.system-int-test.utils.ingest-util :as ingest]
-    [cmr.system-int-test.utils.search-util :as search]
-    [cmr.umm-spec.models.umm-collection-models :as um]
-    [cmr.umm-spec.models.umm-common-models :as cm]
-    [cmr.umm-spec.test.expected-conversion :as exp-conv]))
+    [cmr.system-int-test.utils.search-util :as search]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2" "provguid3" "PROV3" "provguid4" "PROV4" "provguid5" "PROV5"}))

 (deftest search-by-keywords
-  (let [short-name-boost (k2e/get-boost nil :short-name)
-        entry-id-boost (k2e/get-boost nil :entry-id)
-        project-boost (k2e/get-boost nil :project)
-        platform-boost (k2e/get-boost nil :platform)
-        instrument-boost (k2e/get-boost nil :instrument)
-        concept-id-boost (k2e/get-boost nil :concept-id)
-        provider-boost (k2e/get-boost nil :provider)
-        entry-title-boost (k2e/get-boost nil :entry-title)
-        two-d-boost (k2e/get-boost nil :two-d-coord-name)
-        processing-level-boost (k2e/get-boost nil :processing-level-id)
-        science-keywords-boost (k2e/get-boost nil :science-keywords)
-        data-center-boost (k2e/get-boost nil :data-center)
-        psa1 (dc/psa {:name "alpha" :data-type :string :value "ab"})
-        psa2 (dc/psa {:name "bravo" :data-type :string :value "bf"})
-        psa3 (dc/psa {:name "charlie" :data-type :string :value "foo"})
-        psa4 (dc/psa {:name "case" :data-type :string :value "up"})
-        psa5 (dc/psa {:name "novalue" :data-type :string :description "description"})
-        p1 (dc/platform
-            {:short-name "platform_SnB"
-             :long-name "platform_Ln B"
-             :instruments
-             [(dc/instrument {:short-name "isnA" :long-name "ilnA" :technique "itechniqueA"
-                              :sensors [(dc/sensor {:short-name "ssnA" :long-name "slnA"})
-                                        (dc/sensor {:short-name "ssnD" :long-name "slnD"
-                                                    :technique "techniqueD"})]})]})
-        p2 (dc/platform
-            {:short-name "platform_SnA spoonA"
-             :long-name "platform_LnA"
-             :characteristics
-               [(dc/characteristic {:name "char1" :description "char1desc"})
-                (dc/characteristic {:name "char2" :description "char2desc"})]
-             :instruments
-             [(dc/instrument {:short-name "isnB" :long-name "ilnB" :technique "itechniqueB"
-                              :sensors [(dc/sensor {:short-name "ssnB" :long-name "slnB"
-                                                    :technique "techniqueB"})
-                                        (dc/sensor {:short-name "ssnC" :long-name "slnC"
-                                                    :technique "techniqueC"})]})]})
-        p3 (dc/platform {:short-name "spoonA"})
-        p4 (dc/platform {:short-name "SMAP"
-                         :instruments [(dc/instrument {:short-name "SMAP L-BAND RADIOMETER"})]})
-        p5 (dc/platform {:short-name "fo&nA"})
-        p6 (dc/platform {:short-name "spo~nA"})
-        p7 (dc/platform {:short-name "platform7"
-                         :instruments [(dc/instrument {:short-name "INST7"})]})
-        pboost (dc/platform {:short-name "boost"})
-        pr1 (dc/projects "project-short-name")
-        pr2 (dc/projects "Proj-2")
-        sk1 (dc/science-keyword {:category "Cat1"
-                                 :topic "Topic1"
-                                 :term "Term1"
-                                 :variable-level-1 "Level1-1"
-                                 :variable-level-2 "Level1-2"
-                                 :variable-level-3 "Level1-3"
-                                 :detailed-variable "SUPER DETAILED!"})
-        sk2 (dc/science-keyword {:category "Hurricane"
-                                 :topic "Laser spoonA"
-                                 :term "Extreme"
-                                 :variable-level-1 "Level2-1"
-                                 :variable-level-2 "Level2-2"
-                                 :variable-level-3 "Level2-3"})
-        sk3 (dc/science-keyword {:category "Cat2"
-                                 :topic "Topic1"
-                                 :term "Term1"
-                                 :variable-level-1 "Level3-1"
-                                 :variable-level-2 "Level3-2"
-                                 :variable-level-3 "Level3-3"
-                                 :detailed-variable "S@PER"})
-        skboost (dc/science-keyword {:category "boost"
-                                     :topic "boost"
-                                     :term "boost"
-                                     :variable-level-1 "boost"
-                                     :variable-level-2 "boost"
-                                     :variable-level-3 "boost"
-                                     :detailed-variable "boost"})
-        personnel1 (dc/personnel "Bob" "Hope" "bob.hope@nasa.gov" "TECHNICAL CONTACT")
-        personnel2 (dc/personnel "Victor" "Fries" "victor.fries@nsidc.gov" "TECHNICAL CONTACT")
-        personnel3 (dc/personnel "Otto" "Octavious" "otto.octavious@noaa.gov")
-        tdcs1 (dc/two-d "XYZ")
-        tdcs2 (dc/two-d "twoduniq")
-        org (dc/org :archive-center "Some&Place")
-        url1 (dc/related-url {:url "http://cmr.earthdata.nasa.gov"
-                              :description "Earthdata"})
-        url2 (dc/related-url {:url "http://nsidc.org/"
-                              :description "Home page of National Snow and Ice Data Center"})
-        coll1 (d/ingest "PROV1" (dc/collection
-                                 {:entry-title "coll1" :version-description "VersionDescription"}))
-        coll2 (d/ingest "PROV1" (dc/collection
-                                 {:entry-title "coll2" :short-name "ABC!XYZ" :version-id "V001"}))
-        coll3 (d/ingest "PROV1" (dc/collection {:entry-title "coll3" :collection-data-type "OTHER"}))
-        coll4 (d/ingest "PROV2" (dc/collection {:entry-title "coll4" :collection-data-type "OTHER"}))
-        coll5 (d/ingest "PROV2" (dc/collection {:entry-title "coll5" :short-name "Space!Laser"}))
-        coll6 (d/ingest "PROV2" (dc/collection {:entry-title "coll6"
-                                                :organizations [org]
-                                                :projects pr2
-                                                :platforms [p7]}))
-        coll7 (d/ingest "PROV2" (dc/collection {:entry-title "coll7" :version-id "Laser"}))
-        coll8 (d/ingest "PROV2" (dc/collection {:entry-title "coll8" :processing-level-id "PDQ123"}))
-
-        coll9 (d/ingest "PROV2" (dc/collection {:entry-title "coll09" :science-keywords [sk1 sk2]}))
-
-
-        coll10 (d/ingest "PROV2" (dc/collection {:entry-title "coll10"
-                                                 :spatial-keywords ["in out"]
-                                                 :science-keywords [sk3]}))
-        coll11 (d/ingest "PROV2" (dc/collection {:entry-title "coll11" :platforms [p2 p3 p5 p6]
-                                                 :product-specific-attributes [psa5]}))
-        coll12 (d/ingest "PROV2" (dc/collection {:entry-title "coll12" :product-specific-attributes [psa1 psa2 psa3 psa4]}))
-        coll13 (d/ingest "PROV2" (dc/collection {:entry-title "coll13" :two-d-coordinate-systems [tdcs1 tdcs2]}))
-        coll14 (d/ingest "PROV2" (dc/collection {:entry-title "coll14" :short-name "spoonA laser"}))
-        coll15 (d/ingest "PROV2" (dc/collection {:entry-title "coll15" :processing-level-id "plid1"
-                                                 :collection-data-type "SCIENCE_QUALITY" :platforms [p1]
-                                                 :summary "summary" :temporal-keywords ["tk1" "tk2"]}))
-        coll16 (d/ingest "PROV2" (dc/collection-dif {:short-name "entryid4"}) {:format :dif})
-        coll17 (d/ingest "PROV2" (dc/collection {:associated-difs ["DIF-1" "DIF-2"]}))
-        coll18 (d/ingest "PROV2" (dc/collection {:short-name "SNFoobar"}))
-        coll20 (d/ingest "PROV2" (dc/collection {:projects pr1 :entry-title "Mixed"}))
-        coll21 (d/ingest "PROV2" (dc/collection {:entry-title "coll21" :short-name "Laser"}))
-        coll22 (d/ingest "PROV2" (dc/collection {:collection-data-type "NEAR_REAL_TIME" :short-name "Mixed"}))
-        coll23 (d/ingest "PROV1" (dc/collection {:entry-title "coll23" :short-name "\"Quoted\" collection"}))
-        coll24 (d/ingest "PROV2" (dc/collection {:entry-title "coll24" :short-name "coll24" :platforms [p4]}))
-        ;; Adding personnel here to test keyword search using DataCenter contacts
-        coll25 (d/ingest "PROV2" (dc/collection {:entry-title "coll25" :related-urls [url1 url2] :personnel [personnel3]}))
-        coll-boost (d/ingest "PROV2" (dc/collection {:entry-title "boost"
-                                                     :short-name "boost"
-                                                     :platforms [pboost]
-                                                     :science-keywords [skboost]}))
-
-        coll26 (d/ingest "PROV4" (dc/collection-dif10 {:entry-title "coll26" :personnel [personnel1]}) {:format :dif10})
-        coll27 (d/ingest "PROV5" (dc/collection-dif10 {:entry-title "coll27" :personnel [personnel2]}) {:format :dif10})]
+  (let [coll1 (d/ingest "PROV2" (dc/collection {:entry-title "coll10"
+                                                :spatial-keywords ["in out"]}))]

     (index/wait-until-indexed)

     (testing "search by keywords."
-      (are [keyword-str items]
+      (are3 [keyword-str items]
         (let [parameter-refs (search/find-refs :collection {:keyword keyword-str})
-              json-refs (search/find-refs-with-json-query :collection {} {:keyword keyword-str})
-              parameter-matches? (d/refs-match? items parameter-refs)
-              json-matches? (d/refs-match? items json-refs)]
-          (when-not parameter-matches?
-            (println "Parameter search failed")
-            (println "Expected:" (map :entry-title items))
-            (println "Actual:" (map :name (:refs parameter-refs))))
-          (when-not json-matches?
-            (println "JSON Query search failed")
-            (println "Expected:" (map :entry-title items))
-            (println "Actual:" (map :name (:refs json-refs))))
-          (and parameter-matches? json-matches?))
+              json-refs (search/find-refs-with-json-query :collection {} {:keyword keyword-str})]
+          (d/assert-refs-match items parameter-refs)
+          (d/assert-refs-match items json-refs))

-        ;; spatial keywords
-        "in" [coll10]))
+        "search by keywords"
+        "in" [coll1]))

     (testing "Default boosts on fields"
       (are3 [params scores] (is (= (map #(/ % 2.0) scores)
@@ -174,25 +35,8 @@
         "spatial-keyword"
         {:keyword "in out"} [(k2e/get-boost nil :spatial-keyword)]))

-   (testing "Combine keyword and param boosts"
-     ;; Check that the scores are very close to account for slight difference in
-     ;; number coming from elastic.
-     (are3 [params score]
-        (is (< (Math/abs
-                (double (- (/ score 2.0)
-                           (:score (first (:refs (search/find-refs :collection params)))))))
-               0.0000001))
-
-
-       "combine keyword, data center, and instrument"
-       {:keyword "Proj-2" :data-center "Some&Place" :instrument "INST7"}
-       (* project-boost data-center-boost instrument-boost)
-
-       "instrument search and instrument keyword only results in one instrument boost"
-       {:keyword "INST7" :instrument "INST7"} instrument-boost)
-
     (testing "Specified boosts on fields"
       (are3 [params scores] (is (= (map #(/ % 2.0) scores)
                                    (map :score (:refs (search/find-refs :collection params)))))
         "spatial-keyword"
-        {:keyword "in out" :boosts {:spatial-keyword 8.0}} [8.0])))))
+        {:keyword "in out" :boosts {:spatial-keyword 8.0}} [8.0]))))


new reagent components

new reagent components

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
@@ -23,15 +23,26 @@
 (def wc-comp (toolbox/make-component cloud/make-state nil cloud/state-pub-handler {:sliding-in-timeout 5000}))
 (def wc-c-comp (toolbox/make-component wc-c/make-state nil wc-c/state-pub-handler {:sliding-in-timeout 1000}))
 (def ts-comp (toolbox/make-component ts-c/make-state nil ts-c/state-pub-handler {:sliding-in-timeout 1000}))
+(def ws-comp (toolbox-ws/component))
+(def count-comp (toolbox-r/component cv/count-view "tweet-count"))
+(def users-count-comp (toolbox-r/component cv/users-count-view "users-count"))
+(def search-comp (toolbox-r/component sv/search-view "search"))
+(def sort-comp (toolbox-r/component st/sort-view "sort-buttons"))
+(def pag-comp (toolbox-r/component pag/pagination-view "pagination"))
+(def ttc-comp (toolbox-r/component cv/total-count-view "total-tweet-count"))

 (def tweets-comp (toolbox/single-in-single-out tw/init-component))
-
-;;; Initialization of WebSocket communication.
-(def ws-comp (toolbox-ws/component))

 (sub (:state-pub state-comp) :app-state (:sliding-in-chan wc-c-comp))
 (sub (:state-pub state-comp) :app-state (:sliding-in-chan ts-comp))
 (sub (:state-pub state-comp) :app-state (:sliding-in-chan wc-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan count-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan users-count-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan search-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan sort-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan pag-comp))
+(sub (:state-pub state-comp) :app-state (:sliding-in-chan ttc-comp))
+
 (sub (:state-pub state-comp) :app-state (:in-chan tweets-comp))

 (pipe (:out-chan wc-c-comp)   (:in-chan state-comp))
@@ -39,10 +50,3 @@
 (pipe (:out-chan state-comp)  (:in-chan ws-comp))
 (pipe (:out-chan ws-comp)     (:in-chan state-comp))
 (pipe (:out-chan tweets-comp) (:in-chan state-comp))
-
-(toolbox-r/init-components (:state-pub state-comp) (:in-chan state-comp)
-                           [[cv/count-view "tweet-count"] [cv/users-count-view "users-count"]
-                            [cv/total-count-view "total-tweet-count"] [sv/search-view "search"]
-                            [pag/pagination-view "pagination"] [st/sort-view "sort-buttons"]])
-
-


function comments

function comments

--- src/tweetiment/core.clj
+++ src/tweetiment/core.clj
@@ -6,16 +6,24 @@
             [clojure.algo.generic.functor :as fun]
             [tweetiment.twitter :as tw]))

-(defn words [coll]
-  (map s/lower-case (re-seq #"[a-zA-Z]+" coll)))
+(defn words
+  "takes a tweet and returns lower case words ass a seq"
+  [tweet]
+  (map s/lower-case (re-seq #"[a-zA-Z]+" tweet)))

-(defn trim-decimals [n]
+(defn trim-decimals
+  "removes decimals from number"
+  [n]
    (read-string (re-find #"\d+" (str n))))

-(defn tweets [coll]
-  (filter :text (json/read-str coll :key-fn keyword)))
+(defn tweets
+  "extract tweet text contents from json twitter timeline"
+  [json-string]
+  (filter :text (json/read-str json-string :key-fn keyword)))

-(defn make-pair [pair-string]
+(defn make-pair
+  "extract words from a tab separated string"
+  [pair-string]
   (s/split pair-string #"\t+"))

 (defn read-scores [score-file]


lookup should always return a derefable even if nothing is found

--- src/twigs/snapshot.cljc
+++ src/twigs/snapshot.cljc
@@ -45,8 +45,8 @@
               snaps))))

   ILookup
-  #?(:cljs (-lookup [this k] (-lookup this k nil))
-     :clj (valAt [this k] (.valAt this k nil)))
+  #?(:cljs (-lookup [this k] (-lookup this k (delay nil)))
+     :clj (valAt [this k] (.valAt this k (delay nil))))
   (#?(:cljs -lookup :clj valAt) [_ k nf]
     (if (.hasChild ss (name k))
       (let [css (.child ss (name k))]


Improved path handling and code restructured

--- src/my_blog/core.clj
+++ src/my_blog/core.clj
@@ -1,25 +1,29 @@
+(ns my-blog.core
+  (:require [compojure.core :refer :all]
+            [compojure.route :as route]))
+
 (use 'ring.util.response)
 (use 'selmer.parser)

-(ns my-blog.core
-  (:require [compojure.core :refer :all]
-            [compojure.route :as route]))
+; util functions
+(defn path-join [path1 path2]
+  (str (java.nio.file.Paths/get path1 (into-array String [path2]))))

 ; root of the project source
 (def ROOT
   (.getCanonicalPath (clojure.java.io/file ".")))
 ; set templates folder
 (selmer.parser/set-resource-path!
-  (clojure.string/join "/" [ROOT "src/my_blog/templates/"]))
+  (path-join ROOT "src/my_blog/templates/"))
 ; turns off template cache for development
 (selmer.parser/cache-off!)
+
+; views
+(defn home [request]
+  (render-file "index.html" {}))

 ; routes
 (defroutes app
   (GET "/" [] home)
   (route/resources "/")
   (route/not-found "
Page not found
"))
-
-; views
-(defn home [request]
-  (render-file "index.html" {}))


ex has an extra arg

ex has an extra arg

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -55,7 +55,7 @@
       (json-response {"token" (auth-token (get-user username)) "username" username} 200)
       (json-response {"error" "Authentication failed"} 401)))

-  (POST "/rest/v1/ex/:user" {params :params cookies :cookies}
+  (POST "/rest/v1/ex/:user/:_" {params :params cookies :cookies}
         (is-authenticated? params cookies (json-response (create-ex params))))

   (POST "/rest/v1/ex/comment/:id" {params :params cookies :cookies}


refactoring part-from to use parametrized op

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -192,10 +192,7 @@

   (POST "/rest/v1/groups/:name/part" {params :params cookies :cookies}
     (is-authenticated? cookies
-      (let [response (group/part-from (:name params) (user-from-cookie cookies))]
-        (if (:result response)
-          (json-response {:message (:descr response)})
-          (json-response {:message (:descr response)} 400)))))
+      (do-group-oper group/part-from (:name params) (user-from-cookie cookies))))

   (wrap-multipart-params
     (POST "/rest/v1/import" {params :params cookies :cookies}


Uses refer to bring in editor

Uses refer to bring in editor

--- src/wordsmith/core.cljs
+++ src/wordsmith/core.cljs
@@ -3,7 +3,7 @@
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [wordsmith.persistence :as p]
-            [wordsmith.editor :as e]
+            [wordsmith.editor :refer [editor]]
             [cljs.core.async :refer [put! chan <!]]
             [goog.events :as events])
   (:import [goog.events EventType]))
@@ -159,7 +159,7 @@
         (om/build new-document app)
         (om/build save-button app)
         (om/build left-menu app)
-        (om/build e/editor (:input app))))))
+        (om/build editor (:input app))))))

 (om/root
   wordsmith-app


Support callback and compiler options together in render fn

--- src/reagent/dom.cljs
+++ src/reagent/dom.cljs
@@ -38,11 +38,15 @@
    (render comp container tmpl/default-compiler))
   ([comp container callback-or-compiler]
    (ratom/flush!)
-   (let [[compiler callback] (if (fn? callback-or-compiler)
+   (let [[compiler callback] (cond
+                               (map? callback-or-compiler)
+                               [(:compiler callback-or-compiler) (:callback callback-or-compiler)]
+
+                               (fn? callback-or-compiler)
                                [tmpl/default-compiler callback-or-compiler]
-                               ;; TODO: Callback option doesn't make sense now that
-                               ;; val is compiler object, not map.
-                               [callback-or-compiler (:callback callback-or-compiler)])
+
+                               :else
+                               [callback-or-compiler nil])
          f (fn []
              (p/as-element compiler (if (fn? comp) (comp) comp)))]
      (render-comp f container callback))))


simplify specs

simplify specs

--- src/reitit/spec.cljc
+++ src/reitit/spec.cljc
@@ -18,7 +18,7 @@
 (s/def ::raw-route
   (s/cat :path ::path
          :arg (s/? ::arg)
-         :childs (s/* (s/spec (s/and ::raw-route)))))
+         :childs (s/* (s/and ::raw-route))))

 (s/def ::raw-routes
   (s/or :route ::raw-route
@@ -37,31 +37,14 @@
 ;;

 (s/def ::router reitit/router?)
-
 (s/def :reitit.router/path ::path)
-
 (s/def :reitit.router/routes ::routes)
-
 (s/def :reitit.router/meta ::meta)
-
-(s/def :reitit.router/expand fn?
-  #_(s/fspec :args (s/cat :arg ::arg, :opts ::opts)
-             :ret ::route))
-
-(s/def :reitit.router/coerce fn?
-  #_(s/fspec :args (s/cat :route (s/spec ::route), :opts ::opts)
-             :ret ::route))
-
-(s/def :reitit.router/compile fn?
-  #_(s/fspec :args (s/cat :route (s/spec ::route), :opts ::opts)
-             :ret ::result))
-
-(s/def :reitit.router/conflicts fn?
-  #_(s/fspec :args (s/cat :conflicts (s/map-of ::route (s/coll-of ::route :into #{})))))
-
-(s/def :reitit.router/router fn?
-  #_(s/fspec :args (s/cat :routes ::routes, :opts ::opts)
-             :ret ::router))
+(s/def :reitit.router/expand fn?)
+(s/def :reitit.router/coerce fn?)
+(s/def :reitit.router/compile fn?)
+(s/def :reitit.router/conflicts fn?)
+(s/def :reitit.router/router fn?)

 (s/def ::opts
   (s/nilable


scale stars by window size

scale stars by window size

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -92,30 +92,42 @@
                       :alpha 0.0))]
       (macros/with-sprite-set canvas :stars
         [sprs star-spr]
-        (doseq [s sprs] (resources/fadein s :duration 1.5))
+        (doseq [s sprs] (resources/fadein s :duration 15))

         (go (loop [n 2000 c 0]
-              (when (pos? n)
+              (when true ;(pos? n)
                 (<! (events/next-frame))

-                (doall
-                 (map
-                  (fn [{:keys [x y z] :as old} sprite]
-                    (sprite/set-pos! sprite
-                                     (* 4 (- (mod (- x (* 0.3 c z)) 400) 200))
-                                     (* 4 (- y 150))))
-                  stars-set
-                  star-spr))
+                (let [w (.-innerWidth js/window)
+                      h (.-innerHeight js/window)
+                      hw (/ w 2)
+                      hh (/ h 2)
+                      speed -1]
+
+                  (doall
+                   (map
+                    (fn [{:keys [x y z] :as old} sprite]
+                      (sprite/set-pos! sprite
+                                       (- (mod (- (* 4 x) (* speed c z)) w) hw)
+                                       (- (mod (* 4 y) h) hh)))
+                    stars-set
+                    star-spr)))

                 (recur (dec n)
                        (inc c)
                        ))))

+        ;(macros/with-font )
+
+        ;; wait forever
+        (loop []
+          (<! (events/next-frame))
+          (recur))

         (<! (events/wait-time 15000))

-        (doseq [s sprs] (resources/fadeout s :duration 10))
+        ;(doseq [s sprs] (resources/fadeout s :duration 10))
         (<! (events/wait-time 15000))))

     (macros/with-sprite canvas :stars


Test the deps-to-uses helper

Test the deps-to-uses helper

--- test/oxcart/passes/tree_shake_test.clj
+++ test/oxcart/passes/tree_shake_test.clj
@@ -20,3 +20,24 @@
     (is (= (:foo tree) #{}))
     (is (= (:bar tree) #{:foo}))
     (is (= (:baz tree) #{:bar :foo}))))
+
+
+(deftest deps-to-uses-test
+  ;; The tested function is trivially correct, but generative testing
+  ;; is fun.
+  (let [keywords (->> (repeatedly gensym)
+                      (map (comp keyword name))
+                      (take 100)
+                      (vec))
+        keys     (shuffle keywords)
+        deps     (->> (for [k keys]
+                        [k (-> keywords
+                               count
+                               rand-int
+                               (take (shuffle keywords))
+                               set)])
+                      (into {}))
+        uses     (deps-to-uses deps)]
+    (doseq [[k deps] deps
+            d  deps]
+      (is (contains? (get uses d) k)))))


bump version

bump version

--- storm-kafka/project.clj
+++ storm-kafka/project.clj
@@ -1,4 +1,4 @@
-(defproject storm/storm-kafka "0.8.0-wip2"
+(defproject storm/storm-kafka "0.9.0-wip1"
   :source-path "src/clj"
   :java-source-path "src/jvm"
   :javac-options {:debug "true" :fork "true"}


Submitting comments -- needs display

Submitting comments -- needs display

--- src/swartz/controllers.clj
+++ src/swartz/controllers.clj
@@ -126,7 +126,6 @@
 (defn get-post [req]
   (let [post-id (:id (:params req))
         post (first (select posts (where {:id (Integer/parseInt post-id)})))]
-    (pprint post)
     (base-template
      {:content (post-page post)})))

@@ -134,9 +133,9 @@
   (let [params (:params req)
         post-id (Integer/parseInt (:id params))
         post (first (select posts (where {:id post-id})))
-        identity (friend/identity req)]
-    (pprint identity)
+        identity (friend/identity req)
+        user (first (select users (where {:username (:current identity)})))]
     (insert comments (values {:content (:content params)
                               :post_id post-id
-                              :user_id (:id identity)}))
+                              :user_id (:id user)}))
     (redirect (str "/posts/" post-id))))


Fixed one more tests by adding the forget-secret call (so PIN is required)

--- test/freecoin/journey/transactions.clj
+++ test/freecoin/journey/transactions.clj
@@ -222,6 +222,13 @@
                                         ;(kh/remember memory )
              (kh/remember memory :existing-tags (kh/body-selector-count [:select :option]))

+             ;; visit /forget-secret to explicitly scrub the PIN from the session
+             ;; TODO: this was needed as the PIN was not needed and the test failed.
+             ;; Is it because of the DB cleanup after every tests or something else?
+             (k/visit (routes/absolute-path :forget-secret))
+             (kc/check-and-follow-redirect "back to account page")
+             (kc/check-page-is :account [ks/account-page-body] :email (kh/recall memory :sender-email))
+
              ;; do two transactions with overlapping tags:
              ;; tx one:
              (k/visit (routes/absolute-path :get-transaction-form))


cleanup

cleanup

--- test/leiningen/sql_generation_test.clj
+++ test/leiningen/sql_generation_test.clj
@@ -16,8 +16,7 @@
     (is (.startsWith cs-string "CREATE TABLE PUBLIC.table1"))
     (is (.contains cs-string "fooname"))
     (is (.contains cs-string "age"))
-    (is (.contains cs-string "male BOOLEAN DEFAULT TRUE"))
-    (println cs-string)))
+    (is (.contains cs-string "male BOOLEAN DEFAULT TRUE"))))

 (deftest drop-table-h2
   (is (= (str "DROP TABLE " (:name table1-definition)) (liq/drop-table-sql table1-definition))))


Also remove history-path, which isn't used

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -202,7 +202,6 @@
   (let [comms       (:comms @state)
         container   (find-app-container)
         uri-path    (.getPath utils/parsed-uri)
-        history-path "/"
         pusher-imp (pusher/new-pusher-instance)
         controls-tap (chan)
         nav-tap (chan)


back down to 40 layers

back down to 40 layers

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -317,11 +317,11 @@

 (defn setup-entity-id-fetcher [state]
   (let [api-ch (-> state deref :comms :api)]
-    (fetch-entity-ids api-ch 100)
+    (fetch-entity-ids api-ch 40)
     (add-watch state :entity-id-fetcher (fn [key ref old new]
-                                          (when (> 90 (-> new :entity-ids count))
+                                          (when (> 20 (-> new :entity-ids count))
                                             (println "fetching more entity ids")
-                                            (fetch-entity-ids api-ch 100))))))
+                                            (fetch-entity-ids api-ch 40))))))

 (defn ^:export setup! []
   (apply-app-id-hack)


Destructure query

Destructure query

--- src-cljs/frontend/send.cljs
+++ src-cljs/frontend/send.cljs
@@ -276,12 +276,12 @@
 ;; This implementation is merely a prototype, which does some rudimentary
 ;; pattern-matching against a few expected cases to decide which APIs to hit. A
 ;; more rigorous implementation will come later.
-(defmethod send* :remote [[remote query] cb]
-  (if (om-util/mutation? (first query))
+(defmethod send* :remote [[remote [first-expr & rest-of-query :as query]] cb]
+  (if (om-util/mutation? first-expr)
     (do
       ;; Pass a closed channel to ignore the result.
-      (api/mutate (doto (chan) close!) (first query))
-      (send* [remote (next query)] cb))
+      (api/mutate (doto (chan) close!) first-expr)
+      (send* [remote rest-of-query] cb))
     (let [ch (resolve/resolve {:resolvers resolvers
                                :apis (memoize-apis apis)}
                               query (chan))]


bg rotating correctly

bg rotating correctly

--- src-cljs/main/pomodoro.cljs
+++ src-cljs/main/pomodoro.cljs
@@ -13,8 +13,10 @@
 ;; Constants

 (def ^:constant one-min (* 1e3 60))
-(def ^:constant presets {:five (* one-min 5)
-                         :twenty-five (* one-min 25)})
+(comment (def ^:constant presets {:five (* one-min 5)
+                                  :twenty-five (* one-min 25)}))
+(def ^:constant presets {:five 1e3
+                         :twenty-five (* 1e3 2)})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Compatability
@@ -68,8 +70,8 @@
 (def sound (js/Audio. sound-src))
 (defn play-sound [] (do (set! (.-src sound) sound-src) (.play sound)))

-(def ^:constant images ["bg2.jpg"
-                        "bg3.jpg"])
+(def images (atom ["bg2.jpg"
+                    "bg3.jpg"]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; History
@@ -92,7 +94,7 @@
   ([time]
      (let [tmap (time-map time)]
        (merge tmap {:today (get-in tmap [:stime])
-                    :bg (first images)
+                    :bg (first @images)
                     :on? false}))))

 (def state (atom (default-state)))
@@ -120,13 +122,13 @@
     (:five presets)
     (:twenty-five presets)))

-(defn pomodoro? [five twenty-five]
-  (and (= (presets :twenty-five) twenty-five)
-       (= (presets :five) five)))
+(defn pomodoro? [twenty-five five]
+  (and (= (:twenty-five presets) twenty-five)
+       (= (:five presets) five)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Timer logic
-(def ^:constant time-speed 1)
+(def ^:constant time-speed 1e3)

 (def timer-chan
   (let [c (chan)
@@ -135,12 +137,13 @@
                time-speed)]
     c))

+;; Update timer
 (go (while true
       (<! timer-chan)
       (when-not (apply expired? (get-state :stime :etime))
         (set-state! :etime (dec-time (get-state :etime))))))

-
+;; put! to end-chan when timer ends
 (add-watch state :end
            (fn [k r os ns]
              (when (and (get-state :on?) (apply expired? (get-state :stime :etime)))
@@ -150,18 +153,25 @@
       (<! end-chan)
       (>! bg-chan true)
       (play-sound) ;; ding!
+      (swap! history conj (get-state :time))
       (set-state! (default-state (next-time (get-state :time)))))) ;; set next pomodoro session

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Background logic
-(defn set-bg! [bg]
-  (let [img (nth images (rand-int 2))]
-    (set-state! :bg img)))
+(defn set-bg! [bg] (set-state! :bg (first @images)))
+
+(defn rotate [coll]
+  "Place initial value at end of seq"
+  (concat (rest coll) (take 1 coll)))
+
+(defn rotate-images [] (swap! images rotate))

 (go (while true
       (<! bg-chan)
-      (swap! history conj (get-state :time))
       (when (apply pomodoro? (take-last 2 @history))
+        (print @images)
+        (rotate-images)
+        (print @images)
         (set-bg! (get-state :bg)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


update dot export to pre-sort vertices

update dot export to pre-sort vertices

--- src/thi/ng/fabric/utils.cljc
+++ src/thi/ng/fabric/utils.cljc
@@ -15,6 +15,7 @@
      [path vertices flt]
      (->> vertices
           (filter flt)
+          (sort-by :id)
           (mapcat
            (fn [v]
              (if-let [outs @(:outs v)]


+(defn nugent)

+(defn nugent)

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -624,9 +624,20 @@
 (defn benchmark2 []
   (benchmark spec2 5))

-;; (repeatedly #(println (print-out)))
-(defn print-out []
-  (let [mapping1 (mapping spec1 (medium) 0 6)
+(defn do-assocs [accum paths val-at-paths]
+  (if (empty? paths)
+    accum
+    (do-assocs
+     (assoc-in accum
+               (first paths)
+               (first val-at-paths))
+     (rest paths)
+     (rest val-at-paths))))
+
+;; (repeatedly #(println (fo (nugent spec1))))
+;; (repeatedly #(println (fo-ps (nugent spec1))))
+(defn nugent [spec]
+  (let [mapping1 (mapping spec (medium) 0 6)
         all-of-them
         (mapcat (fn [each-mapping]
                   (let [trellis (apply combo/cartesian-product (vals each-mapping))]
@@ -636,11 +647,12 @@
                          trellis)))
                 mapping1)
         good-one (first (shuffle all-of-them))]
-    (fo-ps
-     (->
-      (get good-one [])
-      (assoc-in [:comp] (get good-one [:comp]))
-      (assoc-in [:head :comp] (get good-one [:head :comp]))))))
+    (do-assocs (get good-one [])
+               (keys good-one)
+               (vals good-one))))
+
+
+


working on fixing tests

working on fixing tests

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -394,14 +394,14 @@
            "il l'amuse"))))

 (deftest se-plaindre
-  (let [to-conjugate {:français "se plaindre", :initial false,
-                      :agr {:number :sing,
-                            :person :1st,
-                            :gender :masc},
-                      :essere true,
-                      :infl :present}]
-    (is (= "plains"
-           (babel.francais.morphology/get-string to-conjugate)))))
+  (is (= (conjugate "se plaindre"
+                    {:synsem {:agr {:number :sing,
+                                    :person :1st,
+                                    :gender :masc},
+                              :essere true,
+                              :infl :present}}
+                    @lexicon)
+         "plains")))

 (deftest nous-acheterons
   (let [spec {:synsem {:sem {:tense :future}, :subcat ()},