add fire action

add fire action

--- src/wombats/game/zakano_code.clj
+++ src/wombats/game/zakano_code.clj
@@ -309,8 +309,12 @@
   ;; TODO check to see it the sequence in next-command is more efficient
   next-command)

+(defn get-look-ahead-items
+  "Get n numnber of cells in front of slef"
+  [])
+
 (defn pathfinding-action
-  [{:keys [global-arena global-coords self global-dimensions]}]
+  [{:keys [global-arena global-coords self global-dimensions] :as enriched-state}]
   (let [orientation (get-in self [:contents :orientation])
         look-ahead 3 ;; TODO This should be passed in based off a l.o.s.
         look-ahead-coords (loop [coords []
@@ -337,6 +341,9 @@
                                        :metadata {:direction :right}}
                          :else {:action :move})]}))

+(defn fire-action
+  [])
+
 (defn clueless-action
   ;; if the zakano doesn't know what to do next, it's
   ;; defense mechanism is to spin and shoot.
@@ -366,7 +373,11 @@
     (format-command action-name remaining-action-seq metadata)))

 (def command-priority
-  [{:name "food"
+  [{:name "fire!"
+    :fn fire-action
+    :validate-command (fn [] true)
+    :equality-command (fn [prev next] next)}
+   {:name "food"
     :fn closest-food-action
     :validate-command closest-food-validation
     :equality-command food-equality}


Tweak examples.

Tweak examples.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -107,9 +107,8 @@
   "Return an effect that sets all the dimmers in the sample rig.
   Originally this had to be to a static value, but now that dynamic
   parameters exist, it can vary in response to a MIDI mapped show
-  variable, an oscillator, or (once geometry is implemented), the
-  location of the fixture. You can override the default name by
-  passing in a value with :effect-name"
+  variable, an oscillator, or the location of the fixture. You can
+  override the default name by passing in a value with :effect-name"
   [level & {:keys [effect-name]}]
   (dimmer-effect level (show/all-fixtures) :effect-name effect-name))

@@ -340,7 +339,10 @@
                          :short-name "Beyond 1 1"))
   (ct/set-cue! (:cue-grid *show*) 3 7
                (cues/cue :beyond-cue-1-2 (fn [_] (beyond/cue-effect server 1 2))
-                         :short-name "Beyond 1 2")))
+                         :short-name "Beyond 1 2"))
+  (afterglow.controllers/set-cue! (:cue-grid *show*) 6 7
+                                  (cues/function-cue :snowball-sound :sound-active (show/fixtures-named "snowball")
+                                                     :color :cyan)))

 (defn make-cues


Get playlist in timeout

Get playlist in timeout

--- src/airhead_cljs/core.cljs
+++ src/airhead_cljs/core.cljs
@@ -9,24 +9,26 @@
 (defn update-state! [k value]
   (swap! state assoc k value))

+(defn get-playlist []
+  (GET "http://localhost:8080/api/queue"
+       {:handler #(update-state! :playlist (% "items"))
+        :response-format :json}))
+
 ;; -------------------------
 ;; Views

 (defn server-form []
-  [:div
+  [:form
    [:input {:type "text"
             :value (@state :server)
             :on-change #(update-state! :server
                                        (-> % .-target .-value))}]])

 (defn playlist-div []
-  (GET "http://localhost:8080/api/queue"
-       {:handler #(update-state! :playlist (% "items"))
-        :response-format :json})
-  (fn []
-    [:div [:h2 "Playlist"]
-     [:ul (for [track (@state :playlist)]
-            [:li (track "title")])]]))
+  (js/setTimeout get-playlist 1000)
+  [:div [:h2 "Playlist"]
+   [:ul (for [track (@state :playlist)]
+          [:li (track "title")])]])

 (defn home-page []
   [:div [:h1 "Airhead"]


add defaults to directory options

add defaults to directory options

--- panc/src/main/clojure/org/quattor/pan/pan_annotations.clj
+++ panc/src/main/clojure/org/quattor/pan/pan_annotations.clj
@@ -3,7 +3,7 @@
   (:use clojure.tools.cli
         [clojure.string :only (blank?)])
   (:import (java.io File)
-           org.quattor.pan.CompilerOptions))
+           (org.quattor.pan CompilerOptions CompilerResults)))

 (defn path-splitter-re []
   (re-pattern (str "[^" File/pathSeparator "]+")))
@@ -30,18 +30,25 @@
 (defn get-compiler-options [{base-dir :base-dir output-dir :output-dir}]
     (CompilerOptions/createAnnotationOptions output-dir base-dir))

-(defn generate-annotations [options]
-  (let [compiler-options (get-compiler-options options)]
-    (println compiler-options)))
+(defn generate-annotations [options files]
+  (let [compiler-options (get-compiler-options options)
+        pan-sources (map #(File. %) files)]
+    (org.quattor.pan.Compiler/run compiler-options nil pan-sources)))

 (defn -main [& args]
   (let [[options files banner]
         (cli args
-             ["--base-dir" "base directory for templates" :parse-fn parse-directory]
-             ["--output-dir" "output directory" :parse-fn parse-directory]
+             ["--base-dir" "base directory for templates"
+              :default (current-directory) :parse-fn parse-directory]
+             ["--output-dir" "output directory"
+              :default (current-directory) :parse-fn parse-directory]
              ["--jvm-options" "options for JVM"]
              ["-h" "--help" "print command help" :default false :flag true])]
     (when (:help options)
       (println banner)
       (System/exit 0))
-    (generate-annotations options)))
+    (let [results (generate-annotations options files)]
+      (if-let [errors (.formatErrors results)]
+        (println errors)
+        "")
+      (println (.formatStats results)))))


fix version in client

fix version in client

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -16,7 +16,7 @@
    [cljs.core.async.macros :refer [go go-loop]])
   (:import [goog]))

-(def _figwheel-version_ "0.5.17")
+(def _figwheel-version_ "0.5.18-SNAPSHOT")

 (def js-stringify
   (if (and (exists? js/JSON) (some? js/JSON.stringify))


Add some specs for algorithms.dijkstra.

Add some specs for algorithms.dijkstra.

--- src/cljc/mazes/algorithms/dijkstra.cljc
+++ src/cljc/mazes/algorithms/dijkstra.cljc
@@ -10,6 +10,7 @@
 (spec/def ::unvisited (spec/coll-of ::g/cell :kind set?))
 (spec/def ::distances (spec/map-of ::g/cell ::distance :conform-keys true))
 (spec/def ::step-values (spec/keys :req [::g/grid ::unvisited ::distances ::current]))
+(spec/def ::path (spec/coll-of ::direction :kind sequential?))

 (def infinite-distance #?(:clj Integer/MAX_VALUE, :cljs js/Infinity))

@@ -99,6 +100,9 @@
        (if (complete? distances unvisited)
          {:distances distances}
          (recur (step values)))))))
+(spec/fdef solve
+  :args (spec/cat :grid ::g/grid :origin ::g/cell :destination (spec/? (spec/nilable ::g/cell)))
+  :ret ::distances)

 (defn path
   "Given a grid, an origin cell, a destination cell, and optionally a distance
@@ -121,3 +125,6 @@
              next-cell (key (apply min-key val (select-keys distances (keys neighbors))))
              direction (neighbors next-cell)]
          (recur next-cell (conj path direction)))))))
+(spec/fdef solve
+  :args (spec/cat :grid ::g/grid :origin ::g/cell :destination (spec/? (spec/nilable ::g/cell)))
+  :ret ::path)


Typo.

Typo.

--- src/fnx/core.clj
+++ src/fnx/core.clj
@@ -8,12 +8,12 @@
 ;; small problems: convert a file in one format to another, fetch and parse some
 ;; resource from the network, etc.
 ;;
-;; I would like to share those snippets of functionnalities to my
+;; I would like to share those snippets of functionalities to my
 ;; fellow co-workers, problem is: They may even not know what Clojure
 ;;is.
 ;;
-;; So what I would like to do: Just write my function to get the job
-;; done, but because I put my function in a particular namespace,
+;; So what I would like to do: Just write my functions to get the job
+;; done, but because I put my functions in a particular namespace,
 ;; it's automatically exposed in a web interface, where the user can
 ;; file the parameters with HTML textboxes, click `submit` and get the
 ;; result back.


Some tests were incorrectly commented out.

--- test/structural_typing/guts/mechanics/f_compiling_types.clj
+++ test/structural_typing/guts/mechanics/f_compiling_types.clj
@@ -30,156 +30,156 @@
     (oopsie/explanations oopsies) => [":x should be `pos?`; it is `\"string\"`"]))

-;; (fact "handling ALL"
-;;   (let [type-checker (subject/compile-type (canonicalize {} [[:points ALL :x]]
-;;                                                          {[:points ALL :x] even?}))]
-;;     (oopsie/explanations (type-checker {:points [{:x 1} {:x 2} {:x 3} {:y 1}]}))
-;;     => (just "[:points 0 :x] should be `even?`; it is `1`"
-;;              "[:points 2 :x] should be `even?`; it is `3`"
-;;              "[:points 3 :x] must exist and be non-nil"
-;;              :in-any-order)))
+(fact "handling ALL"
+  (let [type-checker (subject/compile-type (canonicalize {} [[:points ALL :x]]
+                                                         {[:points ALL :x] even?}))]
+    (oopsie/explanations (type-checker {:points [{:x 1} {:x 2} {:x 3} {:y 1}]}))
+    => (just "[:points 0 :x] should be `even?`; it is `1`"
+             "[:points 2 :x] should be `even?`; it is `3`"
+             "[:points 3 :x] must exist and be non-nil"
+             :in-any-order)))

-;;   (fact "a path with multiple values (RANGE)"
-;;     (fact "simple case"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 2 4)] even?}))]
-;;         (fact "a range avoids broken values"
-;;           (oopsie/explanations (type-checker [:wrong :wrong 2 4 :wrong])) => empty?)
+  (fact "a path with multiple values (RANGE)"
+    (fact "simple case"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 2 4)] even?}))]
+        (fact "a range avoids broken values"
+          (oopsie/explanations (type-checker [:wrong :wrong 2 4 :wrong])) => empty?)

-;;         (fact "... but allows processing of values within the range"
-;;           (oopsie/explanations (type-checker [:wrong :wrong 0 41 :wrong]))
-;;           => (just "[3] should be `even?`; it is `41`"))))
+        (fact "... but allows processing of values within the range"
+          (oopsie/explanations (type-checker [:wrong :wrong 0 41 :wrong]))
+          => (just "[3] should be `even?`; it is `41`"))))

-;;     (fact "multiple ranges"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 2 4) (RANGE 1 2)] even?}))]
-;;         (fact "a range avoids broken values"
-;;           (oopsie/explanations (type-checker [:wrong :wrong [:wrong 2 :wrong] [:wrong 4] :wrong])) => empty?)
+    (fact "multiple ranges"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 2 4) (RANGE 1 2)] even?}))]
+        (fact "a range avoids broken values"
+          (oopsie/explanations (type-checker [:wrong :wrong [:wrong 2 :wrong] [:wrong 4] :wrong])) => empty?)

-;;         (fact "... but allows processing of values within the range"
-;;           (oopsie/explanations (type-checker [:wrong :wrong [:wrong 1 :wrong] [:wrong 3]]))
-;;           => (just "[2 1] should be `even?`; it is `1`"
-;;                    "[3 1] should be `even?`; it is `3`"))))
+        (fact "... but allows processing of values within the range"
+          (oopsie/explanations (type-checker [:wrong :wrong [:wrong 1 :wrong] [:wrong 3]]))
+          => (just "[2 1] should be `even?`; it is `1`"
+                   "[3 1] should be `even?`; it is `3`"))))

-;;     (fact "combination of RANGE and ALL"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 2 4) ALL] even?}))]
-;;         (fact "a range avoids broken values"
-;;           (oopsie/explanations (type-checker [:wrong :wrong [2 4 6] [4] :wrong])) => empty?)
+    (fact "combination of RANGE and ALL"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 2 4) ALL] even?}))]
+        (fact "a range avoids broken values"
+          (oopsie/explanations (type-checker [:wrong :wrong [2 4 6] [4] :wrong])) => empty?)

-;;         (fact "... but allows processing of values within the range"
-;;           (oopsie/explanations (type-checker [:wrong :wrong [0 1 2] [2 3]]))
-;;           => (just "[2 1] should be `even?`; it is `1`"
-;;                    "[3 1] should be `even?`; it is `3`"))))
+        (fact "... but allows processing of values within the range"
+          (oopsie/explanations (type-checker [:wrong :wrong [0 1 2] [2 3]]))
+          => (just "[2 1] should be `even?`; it is `1`"
+                   "[3 1] should be `even?`; it is `3`"))))

-;;     (fact "including other path elements"
-;;       (let [type-checker (subject/compile-type
-;;                           (canonicalize {}
-;;                                         {[:a (RANGE 1 3) :b (RANGE 1 5) pos?] even?}))]
-;;         (fact "a range avoids broken values"
-;;           (oopsie/explanations (type-checker {:a [:wrong
-;;                                                   {:b [1  2  2  2  2 1]}
-;;                                                   {:b [1 -1 -1 -1 -1 1]}
-;;                                                   :wrong]})) => empty?)
+    (fact "including other path elements"
+      (let [type-checker (subject/compile-type
+                          (canonicalize {}
+                                        {[:a (RANGE 1 3) :b (RANGE 1 5) pos?] even?}))]
+        (fact "a range avoids broken values"
+          (oopsie/explanations (type-checker {:a [:wrong
+                                                  {:b [1  2  2  2  2 1]}
+                                                  {:b [1 -1 -1 -1 -1 1]}
+                                                  :wrong]})) => empty?)

-;;         (fact "... but allows processing of values within the range"
-;;           (oopsie/explanations (type-checker {:a [:wrong
-;;                                                   {:b [1  2  2  2  3 1]}
-;;                                                   {:b [1 -1 -1  5 -1 1]}
-;;                                                   :wrong]}))
-;;           => (just "[:a 1 :b 4 pos?] should be `even?`; it is `3`"
-;;                    "[:a 2 :b 3 pos?] should be `even?`; it is `5`")))))
+        (fact "... but allows processing of values within the range"
+          (oopsie/explanations (type-checker {:a [:wrong
+                                                  {:b [1  2  2  2  3 1]}
+                                                  {:b [1 -1 -1  5 -1 1]}
+                                                  :wrong]}))
+          => (just "[:a 1 :b 4 pos?] should be `even?`; it is `3`"
+                   "[:a 2 :b 3 pos?] should be `even?`; it is `5`")))))

-;; (fact "compiling a whole type"
-;;   (fact "Simple case"
-;;     (oopsie/explanations ((subject/compile-type (canonicalize {} [:a])) {}))
-;;     => (just ":a must exist and be non-nil"))
+(fact "compiling a whole type"
+  (fact "Simple case"
+    (oopsie/explanations ((subject/compile-type (canonicalize {} [:a])) {}))
+    => (just ":a must exist and be non-nil"))

-;;   (fact "An optional value"
-;;     (let [odd-if-exists (subject/compile-type (canonicalize {} {:a odd?}))]
-;;       (oopsie/explanations (odd-if-exists {})) => empty?
-;;       (oopsie/explanations (odd-if-exists {:a 2})) => (just ":a should be `odd?`; it is `2`")
-;;       (oopsie/explanations (odd-if-exists {:a 3})) => empty?)
+  (fact "An optional value"
+    (let [odd-if-exists (subject/compile-type (canonicalize {} {:a odd?}))]
+      (oopsie/explanations (odd-if-exists {})) => empty?
+      (oopsie/explanations (odd-if-exists {:a 2})) => (just ":a should be `odd?`; it is `2`")
+      (oopsie/explanations (odd-if-exists {:a 3})) => empty?)

-;;     (fact "Note the difference from a required value"
-;;       (let [odd-and-exists (subject/compile-type (canonicalize {} [:a] {:a odd?}))]
-;;         (oopsie/explanations (odd-and-exists {})) => (just ":a must exist and be non-nil")
-;;         (oopsie/explanations (odd-and-exists {:a 2})) => (just ":a should be `odd?`; it is `2`")
-;;         (oopsie/explanations (odd-and-exists {:a 3})) => empty?)))
+    (fact "Note the difference from a required value"
+      (let [odd-and-exists (subject/compile-type (canonicalize {} [:a] {:a odd?}))]
+        (oopsie/explanations (odd-and-exists {})) => (just ":a must exist and be non-nil")
+        (oopsie/explanations (odd-and-exists {:a 2})) => (just ":a should be `odd?`; it is `2`")
+        (oopsie/explanations (odd-and-exists {:a 3})) => empty?)))

-;;   (fact "a path"
-;;     (let [odd-and-exists (subject/compile-type (canonicalize {} [[:a :b]] {:a {:b odd?}}))]
-;;       (oopsie/explanations (odd-and-exists {})) => (just "[:a :b] must exist and be non-nil")
-;;       (oopsie/explanations (odd-and-exists {:a "hi"})) => (just "[:a :b] must exist and be non-nil")
-;;       (oopsie/explanations (odd-and-exists {:a {:b 2}})) => (just "[:a :b] should be `odd?`; it is `2`")
-;;       (oopsie/explanations (odd-and-exists {:a {:b 3}})) => empty?))
+  (fact "a path"
+    (let [odd-and-exists (subject/compile-type (canonicalize {} [[:a :b]] {:a {:b odd?}}))]
+      (oopsie/explanations (odd-and-exists {})) => (just "[:a :b] must exist and be non-nil")
+      (oopsie/explanations (odd-and-exists {:a "hi"})) => (just "[:a :b] must exist and be non-nil")
+      (oopsie/explanations (odd-and-exists {:a {:b 2}})) => (just "[:a :b] should be `odd?`; it is `2`")
+      (oopsie/explanations (odd-and-exists {:a {:b 3}})) => empty?))

-;;   (fact "multiple paths in the type"
-;;     (let [type-checker (subject/compile-type (canonicalize {} {:color string?
-;;                                                        :point {:x integer?
-;;                                                                :y integer?}}))]
-;;       (oopsie/explanations (type-checker {})) => empty? ; all optional
-;;       (oopsie/explanations (type-checker {:color "green"})) => empty?
-;;       (oopsie/explanations (type-checker {:color 1})) => (just ":color should be `string?`; it is `1`")
-;;       (oopsie/explanations (type-checker {:color "green"
-;;                            :point {:x "1"
-;;                                    :y "2"}}))
-;;       => (just "[:point :x] should be `integer?`; it is `\"1\"`"
-;;                "[:point :y] should be `integer?`; it is `\"2\"`"
-;;                :in-any-order))))
+  (fact "multiple paths in the type"
+    (let [type-checker (subject/compile-type (canonicalize {} {:color string?
+                                                       :point {:x integer?
+                                                               :y integer?}}))]
+      (oopsie/explanations (type-checker {})) => empty? ; all optional
+      (oopsie/explanations (type-checker {:color "green"})) => empty?
+      (oopsie/explanations (type-checker {:color 1})) => (just ":color should be `string?`; it is `1`")
+      (oopsie/explanations (type-checker {:color "green"
+                           :point {:x "1"
+                                   :y "2"}}))
+      => (just "[:point :x] should be `integer?`; it is `\"1\"`"
+               "[:point :y] should be `integer?`; it is `\"2\"`"
+               :in-any-order))))

-;; (fact "a path that can't be applied produces an error"
-;;   (fact "ALL"
-;;     (let [type-checker (subject/compile-type (canonicalize {} [[:x ALL :y]]))]
-;;       (type-checker {:x 1}) => (just (contains {:leaf-value nil
-;;                                                 :path [:x ALL :y]
-;;                                                 :whole-value {:x 1}}))
-;;       (oopsie/explanations (type-checker {:x 1})) => (just "[:x ALL :y] is not a path into `{:x 1}`")
-;;       (oopsie/explanations (type-checker {:x :a})) => (just "[:x ALL :y] is not a path into `{:x :a}`")
+(fact "a path that can't be applied produces an error"
+  (fact "ALL"
+    (let [type-checker (subject/compile-type (canonicalize {} [[:x ALL :y]]))]
+      (type-checker {:x 1}) => (just (contains {:leaf-value :unfilled
+                                                :path [:x ALL :y]
+                                                :whole-value {:x 1}}))
+      (oopsie/explanations (type-checker {:x 1})) => (just "[:x ALL :y] is not a path into `{:x 1}`")
+      (oopsie/explanations (type-checker {:x :a})) => (just "[:x ALL :y] is not a path into `{:x :a}`")

-;;       (fact "these are fine, though"
-;;         (oopsie/explanations (type-checker {:x [0]})) => (just "[:x 0 :y] must exist and be non-nil")
-;;         (type-checker {:x []}) => empty?)
+      (fact "these are fine, though"
+        (oopsie/explanations (type-checker {:x [0]})) => (just "[:x 0 :y] must exist and be non-nil")
+        (type-checker {:x []}) => empty?)

-;;       (fact "A path containing an array complains if prefix doesn't exist"
-;;         (oopsie/explanations (type-checker {})) => (just #":x must exist"))
+      (fact "A path containing an array complains if prefix doesn't exist"
+        (oopsie/explanations (type-checker {})) => (just #":x must exist"))

-;;       (fact "an unfortunate side effect of strings being collections"
-;;         (oopsie/explanations (type-checker {:x "string"}))
-;;         => (contains "[:x 0 :y] must exist and be non-nil"))))
+      (fact "an unfortunate side effect of strings being collections"
+        (oopsie/explanations (type-checker {:x "string"}))
+        => (contains "[:x 0 :y] must exist and be non-nil"))))

-;;   (fact "RANGE"
-;;     (fact "ending index just fits"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 1 3)] even?}))]
-;;         (oopsie/explanations (type-checker [0 2 4])) => empty?))
+  (fact "RANGE"
+    (fact "ending index just fits"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 1 3)] even?}))]
+        (oopsie/explanations (type-checker [0 2 4])) => empty?))

-;;     (fact "ending index comes too soon"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 1 3)] even?}))]
+    (fact "ending index comes too soon"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 1 3)] even?}))]

-;;         (oopsie/explanations (type-checker [0 2]))
-;;         => (just "[(RANGE 1 3)] is not a path into `[0 2]`")))
+        (oopsie/explanations (type-checker [0 2]))
+        => (just "[(RANGE 1 3)] is not a path into `[0 2]`")))

-;;     (fact "starting index comes too soon"
-;;       (let [type-checker (subject/compile-type (canonicalize {}
-;;                                                              {[(RANGE 2 5)] even?}))]
+    (fact "starting index comes too soon"
+      (let [type-checker (subject/compile-type (canonicalize {}
+                                                             {[(RANGE 2 5)] even?}))]

-;;         (oopsie/explanations (type-checker [0 2]))
-;;         => (just "[(RANGE 2 5)] is not a path into `[0 2]`")))
+        (oopsie/explanations (type-checker [0 2]))
+        => (just "[(RANGE 2 5)] is not a path into `[0 2]`")))

-;;     (fact "in a previous bug, multiple range expressions all printed with same value"
-;;       (let [type-checker (subject/compile-type
-;;                           (canonicalize {}
-;;                                         {[:a (RANGE 1 4) :b (RANGE 1 5) pos?] even?}))]
-;;         (oopsie/explanations (type-checker {:a [:wrong :wrong
-;;                                                 {:b [1  2  2  2  2 1]}
-;;                                                 {:b [1 -1 -1 -1 -1 1]}
-;;                                                 :wrong]}))
-;;         => (just #"\[:a \(RANGE 1 4\) :b \(RANGE 1 5\) pos\?\] is not a path")))))
+    (fact "in a previous bug, multiple range expressions all printed with same value"
+      (let [type-checker (subject/compile-type
+                          (canonicalize {}
+                                        {[:a (RANGE 1 4) :b (RANGE 1 5) pos?] even?}))]
+        (oopsie/explanations (type-checker {:a [:wrong :wrong
+                                                {:b [1  2  2  2  2 1]}
+                                                {:b [1 -1 -1 -1 -1 1]}
+                                                :wrong]}))
+        => (just #"\[:a \(RANGE 1 4\) :b \(RANGE 1 5\) pos\?\] is not a path")))))


put target config back as it should be

put target config back as it should be


bump frequency

bump frequency

--- src/block_chain/target.clj
+++ src/block_chain/target.clj
@@ -3,7 +3,7 @@
             [clojure.math.numeric-tower :as math]))

 (def default (hex-string (math/expt 2 236)))
-(def frequency 120000)
+(def frequency 300000)

 (defn avg-spacing
   "Finds average time spacing in seconds of a series of times"


remove om dependency in emoji

remove om dependency in emoji

--- src/chat/client/emoji.cljs
+++ src/chat/client/emoji.cljs
@@ -1,5 +1,4 @@
-(ns chat.client.emoji
-  (:require [om.dom :as dom]))
+(ns chat.client.emoji)

 (declare unicode ascii)

@@ -7,17 +6,16 @@
   (let [ext :png]
     (case ext
       :png
-      (dom/img #js {:className "emojione"
-                    :alt shortcode
-                    :title shortcode
-                    :src (str "//cdn.jsdelivr.net/emojione/assets/png/" (last (unicode shortcode)) ".png")})
+      [:img {:class "emojione"
+             :alt shortcode
+             :title shortcode
+             :src (str "//cdn.jsdelivr.net/emojione/assets/png/" (last (unicode shortcode)) ".png")}]
       :svg
-      (dom/object #js {:className "emojione"
-                       :data (str "//cdn.jsdelivr.net/emojione/assets/svg/" (last (unicode shortcode)) ".svg")
-                       :type "image/svg+xml"
-                       :title shortcode
-                       :standby shortcode}))))
-
+      [:object {:class "emojione"
+                :data (str "//cdn.jsdelivr.net/emojione/assets/svg/" (last (unicode shortcode)) ".svg")
+                :type "image/svg+xml"
+                :title shortcode
+                :standby shortcode}])))

 (def unicode {
 ":kiss_ww:" ["1f469-200d-2764-fe0f-200d-1f48b-200d-1f469","1f469-2764-1f48b-1f469"]


putting initing in startup pipeline and using mongi env var to read uri

--- src/clj/hit_wl/handler.clj
+++ src/clj/hit_wl/handler.clj
@@ -40,8 +40,7 @@

 (def pretty-head
   [:head [:link {:href "/css/normalize.css" :rel "stylesheet" :type "text/css"}]
-   [:link {:href "/css/found
-ation.min.css" :rel "stylesheet" :type "text/css"}]
+   [:link {:href "/css/foundation.min.css" :rel "stylesheet" :type "text/css"}]
          [:style {:type "text/css"} "ul { padding-left: 2em }"]
          [:script {:src "/js/foundation.min.js" :type "text/javascript"}]])

@@ -50,14 +49,14 @@
   [:body {:class "row"}
    (into [:div {:class "columns small-12"}] content)])

-(defn init [env]
-  (println "INIT ")
-  (pprint (app-config))
+(defn get-db-config []
+  (-> (:db-config (app-config))
+      (assoc :uri (System/getenv "MONGOHQ_URL"))))

-  (comment  {:collection-name "workouts"
-             :db-name "hit-wl-db"
-             :uri (if (= env :prod) heroku-mongo-connection-uri nil)})
-  (db/init (:db-config (app-config))) )
+(defn init-middleware [handler]
+  ;;dummy middleware handler to execute some init logic on app startup
+  (db/init (get-db-config))
+  handler)

 (defn get-userdata [username]
   {:username username
@@ -92,7 +91,6 @@
                           (do (save-document body)
                               (response
                                {:status  "OK"}))))
-  (GET "/setup" [] (do  (init :dev) (response {:status "inited"})))
   (GET "/login" request
        (h/html5 pretty-head (pretty-body login-form)))
   (GET "/logout" req
@@ -111,6 +109,7 @@

 (def app
   (-> (handler/site app-routes)
+      (init-middleware)
       (friend/authenticate {:allow-anon? true
                             :login-uri "/login"
                             :default-landing-uri "/user/profile"


Fixed typo in examples.clj

Fixed typo in examples.clj

--- src/clj_flotr/examples.clj
+++ src/clj_flotr/examples.clj
@@ -175,9 +175,8 @@

-; You can call example function by using following two lines:
+; You can call example function by using following three lines:
 ;(test-pie-charts)
 ;(test-line-charts)
 ;(test-stacked-bars)

-


ENH: exercises 1-3

ENH: exercises 1-3

--- src/clj_prj03/ch5_fwpd.clj
+++ src/clj_prj03/ch5_fwpd.clj
@@ -61,3 +61,61 @@
 (mapify-row [:name] ["Joe"])

 (glitter-filter 3 (mapify (parse (slurp filename))))
+
+
+;; Exercise 1. Get just the names
+(defn glitter-filter-names
+  [& glitter-filter-args]
+  (map #(:name %)
+    (apply glitter-filter glitter-filter-args)))
+
+(glitter-filter-names 3 (mapify (parse (slurp filename))))
+
+;; Exercise 2. Write a prepend method that adds someone to the top of the list
+(defn prepend
+  [suspect-name suspect-list]
+  (conj suspect-list suspect-name))
+
+(def susps (glitter-filter 3 (mapify (parse (slurp filename)))))
+
+(prepend {:name "Dracula" :glitter-index 5} susps)
+
+;; Exercise 3. Write a validate function to check presence of attributes
+;; :name and :glitter-index
+(defn validate
+  [val-fns record]
+  (every? identity (map #((second %) ((first %) record)) val-fns)))
+
+(defn validate-name
+  [name]
+  (def res (and
+            ; name should be longer than 3 chars (stupid check, but whatever)
+            (> (count name) 3)
+            ; check there are no numbers in the name
+            (nil? (re-matches #".*\d.*" name))
+            ))
+  res)
+
+(validate-name "John Doe")
+
+(defn validate-glitter
+  [x]
+  ; (println "in validate-glitter with arg" x)
+  (and
+    (integer? x)
+    (>= x 0)
+    (<= x 100)
+  ))
+
+(def validations {:name validate-name
+                  :glitter-index validate-glitter})
+
+(validate validations {:name "John Doe" :glitter-index 12})
+(validate validations {:name "John Doe" :glitter-index 120})
+(validate validations {:name "John Doe" :glitter-index -12})
+(validate validations {:name "John Doe23" :glitter-index 12})
+(validate validations {:name "e" :glitter-index -12})
+(validate validations {:name "e" :glitter-index 2})
+(validate validations {})
+(validate validations {:name "John Doe"})
+(validate validations {:glitter-index 12})


Adding base delete

Adding base delete

--- src/cljs/bmihw/manage.cljs
+++ src/cljs/bmihw/manage.cljs
@@ -20,13 +20,13 @@
   [{id :id user "username" target "target-username" keyword "keyword" content "content" :as event}]
   (let [current-user (get-in @auth ["twitter" "username"])]
     (.log js/console (str "Event User: " user ", Current User:" current-user))
-    (if (= user current-user)
-      (swap! events conj {:id id
-                          :user user
-                          :keyword keyword
-                          :target target
-                          :drunk (drunk? event)
-                          :content content}))))
+    #_(if (= user current-user))
+       (swap! events conj {:id id
+                           :user user
+                           :keyword keyword
+                           :target target
+                           :drunk (drunk? event)
+                           :content content})));;)

 (defn handle-childsnapshot
   [snapshot]
@@ -35,8 +35,12 @@
     (if val
       (add-event (merge {:id key} (js->clj val))))))

-(.on fb "child_added" handle-childsnapshot)
-
+(defn delete-page
+  []
+  [:div
+   [:p "Always do sober what you said you'd do drunk. That will teach you to keep your mouth shut."]
+   [:i "- Ernest Hemmingway"]])
+
 (defn manage-page
   []
   (let [who (get-in auth ["uid"])]
@@ -45,14 +49,18 @@
 	    [:tr
 	     [:th "Drunk"][:th "Event"][:th "Insult"][:th "Keyword"] [:td who]]
      (for [event @events]
-       [:tr
+       [:tr {:key (:id event)}
         [:td (or (and (:drunk event) "Hell Yeah!") "Nope")]
         [:td (:target event)]
         [:td (:content event)]
         [:td (:keyword event)]
-        [:td [:input {:type :button :value "Delete"}]]])]]))
+        [:td [:a {:href "#/delete"} "Delete"]]])]]))

+(.on fb "child_added" handle-childsnapshot)

 (secretary/defroute "/manage" []
   (session/put! :current-page #'manage-page))

+(secretary/defroute "/delete" []
+  (session/put! :current-page #'delete-page))
+


Added a map generation function.

Added a map generation function.

--- src/clojure_robby/core.clj
+++ src/clojure_robby/core.clj
@@ -6,9 +6,12 @@
   (reduce * (repeat n x)))

-(def map-size 20)
-(def tiles [\w \p \g])
-(def actions [\u \d \l \r \p])
+(def map-size 20) ; Size of the map used for robot simulation.
+(def gold-prob 10) ; Probability in 100 that a tile contains gold.
+(def simul-steps 100) ; Steps to allow the robot to make in a simulation.
+(def tiles [\w \p \g]) ; Tiles that populate the map.
+(def actions [\u \d \l \r \p]) ; Actions the robot can take.
+

 ; DNA functios
 (defn rand-dna []
@@ -23,7 +26,23 @@
     (if (< (rand-int 100) 50) a b))
   (map choose-rand a b))

+
 ; Fitness evaluation functions
+(defn rand-map []
+  "Initializes a map with walls at the boundaries and randomly positioned gold."
+  (def insides (- map-size 2))
+  (def wall-row (vec (repeat map-size \w)))
+  (defn rand-tile []
+    (if (< (rand-int 100) gold-prob) \g \p))
+  (defn rand-row []
+    (vec (concat [\w] (repeatedly insides rand-tile) [\w])))
+  (vec (concat [wall-row] (repeatedly insides rand-row) [wall-row])))
+
+(defn on-index [themap x y]
+  (nth (nth themap y) x))
+
+;(defn simulate [dna onmap]
+ ; "Simulates the DNA on a map. Evaluates to the score the robot achieved in simul-steps."

 (defn -main


Renamed to replay all button.

Renamed to replay all button.

--- src/cbfg/vis.cljs
+++ src/cbfg/vis.cljs
@@ -271,7 +271,7 @@
                             </select>
                             <button id='" el-prefix "-pause'>❚❚ pause</button>
                             <button id='" el-prefix "-step'>▶❚ step</button>
-                            <button id='replay'>↻ replay</button>"))
+                            <button id='replay'>↻ replay all</button>"))
   (let [run-controls
         {"run"   #(do (when (< @event-delay 0) (put! step-ch true))
                       (reset! event-delay


More accurate message for non-function init

--- library/src/doo/runner.cljs
+++ library/src/doo/runner.cljs
@@ -52,7 +52,7 @@
 ;; Karma starts the runner with arguments
 (defn ^:export run! [a]
   (if-not (fn? *main-cli-fn*)
-    (do (println "WARNING: doo's init function was not set")
+    (do (println "WARNING: doo's init function was not set or is not a function")
         (exit! false))
     (try
       (*main-cli-fn* a)


Include usage example

Include usage example

--- src/dot_utility/radial.clj
+++ src/dot_utility/radial.clj
@@ -171,3 +171,6 @@
        ("Availability" 8 10)
        ("Portability" 5 10)
        ("Modifiability" 3 10)])
+
+(comment
+  (show-radar-display test-data))


Rename site-resource to site-test-resource

--- test/comic_reader/sites_test.clj
+++ test/comic_reader/sites_test.clj
@@ -66,7 +66,7 @@
           io/as-file
           .exists))

-(defn site-resource [resource]
+(defn site-test-resource [resource]
   (let [resource-path (format "%s/%s"
                               (site-test-folder)
                               resource)]
@@ -84,11 +84,11 @@
            "`resources/test/" site-name "'")))

 (defn image-page-html []
-  (when-let [image-resource (site-resource "image.html")]
+  (when-let [image-resource (site-test-resource "image.html")]
     (html/html-resource image-resource)))

 (defn chapter-list-html []
-  (when-let [image-resource (site-resource "chapter_list.html")]
+  (when-let [image-resource (site-test-resource "chapter_list.html")]
     (html/html-resource image-resource)))

 (defn test-extract-image-tag [html image-tag]
@@ -105,7 +105,8 @@

 (defn test-image-page-extraction []
   (let [site ((get-sites) site-name)
-        results (try-read-file (site-resource "image.clj"))]
+        results (try-read-file
+                 (site-test-resource "image.clj"))]
     (if-let [html (image-page-html)]
       (call-with-options
        site
@@ -119,7 +120,7 @@
 (defn test-extract-chapters-list []
   (let [site ((get-sites) site-name)
         results (try-read-file
-                 (site-resource "chapter_list.clj"))]
+                 (site-test-resource "chapter_list.clj"))]
     (if-let [html (chapter-list-html)]
       (call-with-options
        site


Add some logging when namespaces are scanner or the cache is cleared

--- src/io/aviso/rook/core.clj
+++ src/io/aviso/rook/core.clj
@@ -1,5 +1,6 @@
 (ns io.aviso.rook.core
   (:require
+    [clojure.tools.logging :as l]
     [compojure.core :as compojure]
     [clout.core :as clout]
     [clojure.core.memoize :as memo]
@@ -147,6 +148,7 @@
 (defn- get-compiled-paths-uncached [namespace]
   (->> (get-available-paths namespace)
        (map (fn [[[request-method path] fun]]
+              (l/debugf "Mapping %s `%s' to %s" request-method path fun)
               [[request-method (clout/route-compile path)] fun]))
        (remove nil?)))

@@ -154,8 +156,12 @@

 (defn clear-namespace-cache!
   "Clear namespace cache, forcing a re-scan of every namespace checked beforehand."
-  ([] (memo/memo-clear! get-compiled-paths))
-  ([namespace] (memo/memo-clear! get-compiled-paths [namespace])))
+  ([]
+   (memo/memo-clear! get-compiled-paths)
+   (l/debug "Cleared compiled path cache."))
+  ([namespace]
+   (memo/memo-clear! get-compiled-paths [namespace])
+   (l/debugf "Cleared compiled path cache for namespace %s." namespace)))

 (defn namespace-middleware
 "Middleware that scans provided namespace and if any of the functions defined there matches the route spec -


make it easier to dispatch in mouse-moved

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -132,34 +132,38 @@
   (-> state
       (assoc-in [:drawing :layer :layer/text] value)))

+(defn move-in-progress-drawing [state x y]
+  (let [[rx ry] (cameras/screen->point (:camera state) x y)
+        [snap-x snap-y] (cameras/snap-to-grid (:camera state) rx ry)
+        points ((fnil conj []) (get-in state [:drawing :points]) {:x x :y x :rx rx :ry ry})]
+    (-> state
+        (assoc-in [:drawing :points] points)
+        (update-in [:drawing :layer] assoc
+                   :layer/current-x snap-x
+                   :layer/current-y snap-y)
+        (update-in [:drawing :layer]
+                   (fn [layer]
+                     (merge
+                      layer
+                      (when (= :text (get-in state state/current-tool-path))
+                        {:layer/start-x snap-x
+                         :layer/start-y snap-y})
+                      (when (= :pen (get-in state state/current-tool-path))
+                        {:layer/path (svg/points->path points)})
+                      (when (= :circle (get-in state state/current-tool-path))
+                        {:layer/rx (Math/abs (- (:layer/start-x layer)
+                                                (:layer/current-x layer)))
+                         :layer/ry (Math/abs (- (:layer/start-y layer)
+                                                (:layer/current-y layer)))}))))))  )
+
 (defmethod control-event :mouse-moved
   [target message [x y] state]
-  (let [[rx ry] (cameras/screen->point (:camera state) x y)
-        [snap-x snap-y] (cameras/snap-to-grid (:camera state) rx ry)]
-    (let [r (if (get-in state [:drawing :in-progress?])
-              (let [points ((fnil conj []) (get-in state [:drawing :points]) {:x x :y x :rx rx :ry ry})]
-                (-> state
-                    (update-mouse x y)
-                    (assoc-in [:drawing :points] points)
-                    (update-in [:drawing :layer] assoc
-                               :layer/current-x snap-x
-                               :layer/current-y snap-y)
-                    (update-in [:drawing :layer]
-                               (fn [layer]
-                                 (merge
-                                  layer
-                                  (when (= :text (get-in state state/current-tool-path))
-                                    {:layer/start-x snap-x
-                                     :layer/start-y snap-y})
-                                  (when (= :pen (get-in state state/current-tool-path))
-                                    {:layer/path (svg/points->path points)})
-                                  (when (= :circle (get-in state state/current-tool-path))
-                                    {:layer/rx (Math/abs (- (:layer/start-x layer)
-                                                            (:layer/current-x layer)))
-                                     :layer/ry (Math/abs (- (:layer/start-y layer)
-                                                            (:layer/current-y layer)))}))))))
-              (update-mouse state x y))]
-      r)))
+  (-> state
+      (update-mouse x y)
+      (cond-> (get-in state [:drawing :in-progress?])
+              (move-in-progress-drawing x y)
+
+              )))

 ;; TODO: this shouldn't assume it's sending a mouse position
 (defn maybe-notify-subscribers! [current-state x y]


Implement padding of trailing fill bits to bit seqeuence.

--- src/ais/core.clj
+++ src/ais/core.clj
@@ -1,6 +1,6 @@
 (ns ais.core
   (:require [clojure.data.json :as json])
-  (:require [ais.extractors  :as ais-extractors])
+  (:require [ais.extractors  :as ais-ex])
   (:require [ais.mappings  :as ais-mappings])
   (:require [ais.types :as ais-types])
   (:require [ais.util :as ais-util])
@@ -61,13 +61,14 @@
     (decode-binary-payload binary-payload specs)))

 (defn parse-envelope [envelope]
-  (let [bits (payload->binary (ais-extractors/extract-payload envelope))
+  (let [fill (ais-ex/extract-fill-bits envelope)
+        bits (ais-util/pad (payload->binary (ais-ex/extract-payload envelope)) fill)
        [type binary-payload] (split-type-binary-payload bits)]
     (parse-binary type binary-payload)))
-    ;(if (not-any? nil? envelope-cksum)
+

 (defn parse [line]
-  (let [[envelope checksum] (ais-extractors/extract-envelope-checksum line)]
+  (let [[envelope checksum] (ais-ex/extract-envelope-checksum line)]
     (if (not-any? nil? [envelope checksum])
       (if (valid-envelope? envelope checksum)
         (try
@@ -82,10 +83,10 @@
 ;; ---

 (defn parse-group [msgs]
-  (let [[msg-1 msg-2] (sort-by ais-extractors/extract-fragment-number msgs)
-        fill (ais-extractors/extract-fill-bits msg-2)
-        payload (reduce str (map ais-extractors/extract-payload [msg-1 msg-2]))
-        full-msg (str (ais-extractors/extract-packet-type msg-1) ",1,1,1,A," payload "," fill)
+  (let [[msg-1 msg-2] (sort-by ais-ex/extract-fragment-number msgs)
+        fill (ais-ex/extract-fill-bits msg-2)
+        payload (reduce str (map ais-ex/extract-payload [msg-1 msg-2]))
+        full-msg (str (ais-ex/extract-packet-type msg-1) ",1,1,1,A," payload "," fill)
        ]
     (str full-msg "*" (ais-util/checksum full-msg))))


Add download-modes to /info page.

Add download-modes to /info page.

--- src/beebster_clj/views.clj
+++ src/beebster_clj/views.clj
@@ -1,5 +1,5 @@
 (ns beebster-clj.views
-  (:use hiccup.core hiccup.element hiccup.util hiccup.page hiccup.form beebster-clj.core))
+  (:use hiccup.core hiccup.element hiccup.util hiccup.page hiccup.form beebster-clj.core [clojure.java.shell :only [sh]]))

 (def categories
   '("popular" "highlights" "films" "nature"
@@ -121,7 +121,7 @@

 (defn info-page
   [index]
-  (let [[thumb desc title] (load-thumbandinfo-for-index index)]
+  (let [[thumb desc title modes] (load-thumbandinfo-for-index index)]
     (html
      (base-template "Info")
      (header '(("/" "search") ("/about" "about")))
@@ -130,5 +130,20 @@
       [:p (first title)]]
      [:div.infothumb
       [:img {:src (first thumb)}]]
+     [:form.form-inline
+      {:role "form" :method "post" :action (apply str "/download?index=" index)}
+      [:div.form-group
+       [:select {:name "mode" :label.sr-only "download modes"}
+        (for [i modes]
+          [:option {:value i :selected (= i "mode") } i])]]
+      [:div.form-group
+       [:input {:type "submit" :value "Download" :class "btn btn-default"
+                :label.sr-only "download-modes"}]]]
      [:div.iplayerinfo
       [:p (first desc)]])))
+
+(defn download-page
+  [index mode]
+  (let [prog (future (apply sh  (iplayer-download-command index mode)))]
+    (html
+     (:p (apply str "Downloading " index mode)))))


take out this debug setup

take out this debug setup

--- src/block_chain/target.clj
+++ src/block_chain/target.clj
@@ -3,10 +3,8 @@
             [environ.core :refer [env]]
             [clojure.math.numeric-tower :as math]))

-(def default "1100000000000000000000000000000000000000000000000000000000000000")
-;; (def default (env :default-target))
-(def frequency 10)
-;; (def frequency 300000)
+(def default (env :default-target))
+(def frequency 300000)

 (defn avg-spacing
   "Finds average time spacing in seconds of a series of times"
@@ -51,7 +49,6 @@
   "Calculate the appropriate next target based on the time frequency
    of recent blocks."
   [blocks]
-  default
-  #_(if (> (count blocks) 8)
+  (if (> (count blocks) 8)
     (adjusted-target blocks frequency)
     default))


Add some environment variables to control store test behavior.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -459,8 +459,12 @@
          max-size 1024
          operations [:basic]
          concurrency 4
-         iterations 100
-         repetitions 10}}]
+         iterations (or (some-> (System/getenv "BLOCKS_STORE_TEST_ITERATIONS")
+                                (Integer/parseInt))
+                        100)
+         repetitions (or (some-> (System/getenv "BLOCKS_STORE_TEST_REPETITIONS")
+                                 (Integer/parseInt))
+                         10)}}]
   {:pre [(fn? constructor)]}
   (let [test-blocks (generate-blocks! blocks max-size)]
     (carly/check-system "integration testing" iterations


Refactor search nodes.

Refactor search nodes.

--- src/exp/sahdd.clj
+++ src/exp/sahdd.clj
@@ -86,12 +86,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outcome maps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn make-descendents [state action prim-constructor ref-constructor]
-  (if (env/primitive? action)
-      (when-let [[ss sr] (and (env/applicable? action state) (env/successor action state))]
-        [(prim-constructor (vary-meta ss assoc :opt [action]) sr)])
-    (map ref-constructor (hierarchy/immediate-refinements action state))))
-
 (defn generalize-outcome-pair [[outcome-state reward] gen-state reward-to-gen-state]
   [(vary-meta (env/apply-effects gen-state (env/extract-effects outcome-state)) assoc
               :opt (concat (:opt (meta gen-state)) (:opt (meta outcome-state))))
@@ -117,11 +111,13 @@
 (defn make-incremental-dijkstra-search [initial-nodes]
   (let [q (make-queue initial-nodes)]
     (reify IncrementalSearch
-      (next-partial-solution [min-reward]
-        (incremental-dijkstra q min-reward expand-node extract-goal-state)))))
+           (next-partial-solution [min-reward]
+             (incremental-dijkstra q min-reward expand-node extract-goal-state)))))
+

 ;; TODO: need "generalized-goal" dijkstra search.
+;; TODO: single-goal.

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Exhaustive Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -186,6 +182,26 @@
                            context-state context-reward))))

+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; State-Action searches ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare make-search-node)
+
+(defn make-incremental-dijkstra-sa-search [state action]
+  (make-incremental-dijkstra-search [(make-search-node :transparent [state 0] [action])]))
+
+(defn make-abstracted-incremental-dijkstra-sa-search [state reward action]
+  (let [context (env/precondition-context action state)]
+    (make-search-in-context
+     (get-cached-search [(env/extract-context state context) (env/action-name action)]
+       (make-incremental-dijkstra-sa-search (env/get-logger state context) action))
+     state reward)))
+
+(defn make-abstracted-exhaustive-dijkstra-sa-search [state reward action]
+  (make-exhaustive-search (make-abstracted-incremental-dijkstra-sa-search state reward action)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Search Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -197,13 +213,12 @@
   (expand-node        [se new-threshold]
     "Returns PartialResult of SearchNodes."))

+
+
 (deftype GoalNode [goal-state]
   SearchNode
   (extract-goal-state []           goal-state)
   (expand-node        [min-reward] (throw (UnsupportedOperationException.))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Named Node (Helper) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; Named node is simple non-terminal node whose equality semantics are given by name.
 (deftype NamedNode [name expand-fn] :as this
@@ -212,48 +227,44 @@
   (hashCode [] (hash name))
   SearchNode
   (extract-goal-state []  nil)
-  (expand-node        [min-reward] (expand-fn min-reward)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Recursive Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare make-sp-recursive-node)
-
-(defn make-initial-sp-nodes [state action]
-  (make-descendents state action
-    (fn [ss sr] [(GoalNode ss) sr])
-    (fn [ref] (make-sp-recursive-node [state 0] ref))))
-
-(defn make-sp-recursive-node [[state reward] remaining-actions]
+  (expand-node        [min-reward] (expand-fn this min-reward)))
+
+
+(defn make-node-descendant [parent & args]
+  (apply make-search-node :recursive args))
+
+(defn make-recursive-expander [sp more-actions]
+  (fn sp-recursive-expand [this min-reward]
+      (let [{:keys [result-pairs max-reward]} (next-partial-solution (force sp) min-reward)]
+        (PartialResult (map #(make-node-descendant this % more-actions) result-pairs) max-reward))))
+
+;(def #^IFn node-type-policy)
+
+(defn make-search-node [type [state reward :as result] remaining-actions]
   [(if-let [[f & r] (seq remaining-actions)]
-     (let [context (env/precondition-context f state)
-           sp      (delay
-                    (make-search-in-context
-                     (get-cached-search [(env/extract-context state context) (env/action-name f)]
-                       (make-incremental-dijkstra-search
-                        (make-initial-sp-nodes (env/get-logger state context) f)))
-                     state reward))]
-       (NamedNode [state (map env/action-name remaining-actions)]
-          (fn sp-recursive-expand [min-reward]
-            (let [{:keys [result-pairs max-reward]} (next-partial-solution (force sp) min-reward)]
-              (PartialResult (map #(make-sp-recursive-node % r) result-pairs) max-reward)))))
+       (NamedNode [state (map env/action-name remaining-actions)]
+         (case type
+          :transparent
+            (fn sp-transparent-expand [this min-reward]
+              (PartialResult
+               (if (env/primitive? f)
+                 (when-let [[ss sr] (and (env/applicable? f state) (env/successor f state))]
+                   [(make-node-descendant this [(vary-meta ss assoc :opt [f]) (+ sr reward)] r)])
+                 (for [ref (hierarchy/immediate-refinements f state)]
+                   (make-node-descendant this [state reward] (concat ref r))))
+               Double/NEGATIVE_INFINITY))
+          :recursive
+            (make-recursive-expander
+             (delay (make-abstracted-incremental-dijkstra-sa-search state reward f)) r)
+          :recursive-exhaustive
+            (make-recursive-expander
+             (delay (make-abstracted-exhaustive-dijkstra-sa-search state reward f)) r)))
      (GoalNode state))
    reward])

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Transparent Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn make-sp-transparent-node [[state reward] remaining-actions]
-  [(if-let [[f & r] (seq remaining-actions)]
-       (NamedNode [state (map env/action-name remaining-actions)]
-         (fn sp-transparent-expand [min-reward]
-           (PartialResult
-            (make-descendents state f
-              (fn [ss sr] (make-sp-transparent-node [ss (+ sr reward)] r))
-              (fn [ref]   (make-sp-transparent-node [state reward] (concat ref r))))
-            Double/NEGATIVE_INFINITY)))
-     (GoalNode state))
-   reward])
+
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Semi-Transparent Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -282,7 +293,7 @@
         [(map env/action-name (:opt (meta s))) r ]))))

 (defn sahucs-simple [henv]
-  (hierarchical-search henv (fn [s a] (make-incremental-dijkstra-search (make-initial-sp-nodes s a)))))
+  (hierarchical-search henv (fn [s a] (make-incremental-dijkstra-sa-search s a))))


Use the input directly instead of { "data": {...} }

--- src/bzzz/core.clj
+++ src/bzzz/core.clj
@@ -95,8 +95,8 @@
              "/favicon.ico" "" ;; XXX

              ;; FIXME use post instead?
-             "/_state/ro_merge"      (state/ro-merge (:data input))
-             "/_state/ro_deep_merge" (state/ro-deep-merge (:data input))
+             "/_state/ro_merge"      (state/ro-merge input)
+             "/_state/ro_deep_merge" (state/ro-deep-merge input)
              "/_state/ro_rename_key" (state/ro-rename-key (:from_key input) (:to_key input))

              (index-search/search input))


fix keyword equality comparison (identical? vs =) for CLJS in method matching

--- src/calfpath/internal.cljc
+++ src/calfpath/internal.cljc
@@ -100,13 +100,23 @@
                         :headers {"Allow"        method-string
                                   "Content-Type" "text/plain"}
                         :body (str "405 Method not supported. Only " method-string " is supported.")}]
-      `(if (identical? ~method-keyword (:request-method ~request))
+      ;; In CLJS `defmacro` is called by ClojureJVM, hence reader conditionals always choose :clj -
+      ;; so we discover the environment using a hack (:ns &env), which returns truthy for CLJS.
+      ;; Reference: https://groups.google.com/forum/#!topic/clojure/DvIxYnO1QLQ
+      ;; Reference: https://dev.clojure.org/jira/browse/CLJ-1750
+      `(if (~(if (:ns &env) `= `identical?)
+             ~method-keyword (:request-method ~request))
          ~expr
          ~default-expr)))
   ([method-keyword request expr default-expr]
     (when-not (valid-method-keys method-keyword)
       (expected (str "a method key (" valid-method-keys ")") method-keyword))
-    `(if (identical? ~method-keyword (:request-method ~request))
+    ;; In CLJS `defmacro` is called by ClojureJVM, hence reader conditionals always choose :clj -
+    ;; so we discover the environment using a hack (:ns &env), which returns truthy for CLJS.
+    ;; Reference: https://groups.google.com/forum/#!topic/clojure/DvIxYnO1QLQ
+    ;; Reference: https://dev.clojure.org/jira/browse/CLJ-1750
+    `(if (~(if (:ns &env) `= `identical?)
+           ~method-keyword (:request-method ~request))
        ~expr
        ~default-expr)))


Turned on validation in sessions.clj.

Turned on validation in sessions.clj.

Fixed a related bug. Closes #50.

--- src/clj/shale/sessions.clj
+++ src/clj/shale/sessions.clj
@@ -111,7 +111,7 @@
    (s/optional-key :session) SessionInRedis
    (s/optional-key :node)    NodeInRedis})

-(s/defn old->new-session-model :- SessionAndNode
+(s/defn ^:always-validate old->new-session-model :- SessionAndNode
   [session-model :- OldSessionViewModel]
   (merge
     (select-keys session-model [:id])
@@ -240,7 +240,7 @@
   (try (do (to-async wd url) nil)
     (catch WebDriverException e :webdriver-is-dead)))

-(s/defn session-go-to-url
+(s/defn ^:always-validate session-go-to-url
   [pool :- SessionPool
    id   :- s/Str
    url  :- s/Str]
@@ -263,14 +263,14 @@
     :go-to-url s/Str
     :reserve s/Bool))

-(s/defn save-session-tags-to-redis
+(s/defn ^:always-validate save-session-tags-to-redis
   [pool :- SessionPool
    id :- s/Str
    tags]
   (car/wcar (:redis-conn pool)
     (sset-all (session-tags-key id) tags)))

-(s/defn save-session-diff-to-redis
+(s/defn ^:always-validate save-session-diff-to-redis
   [pool :- SessionPool
    id   :- s/Str
    session]
@@ -297,6 +297,7 @@
                  current-url nil
                  webdriver-id nil}
             :as modifications}]
+  (s/validate SessionPool pool)
   (info (format "Modifying session %s, %s" id (str modifications)))
   (when (view-model-exists? pool id)
     (if (or (not current-url)
@@ -328,6 +329,7 @@
               extra-desired-capabilities nil
               current-url nil}
          :as requirements}]
+  (s/validate SessionPool pool)
   (s/validate (s/maybe NodeView) node)
   (info (format "Creating a new session.\nRequirements: %s"
                 (str requirements)))
@@ -441,7 +443,7 @@
                                (assoc :reserved reserved))]
             (create-session pool create-req)))))))

-(s/defn destroy-webdriver!
+(s/defn ^:always-validate destroy-webdriver!
   [pool         :- SessionPool
    webdriver-id :- s/Str
    node-url     :- s/Str]
@@ -458,6 +460,8 @@

 (defn destroy-session
   [pool id & {:keys [immediately] :or [immediately true]}]
+  (s/validate SessionPool pool)
+  (s/validate s/Str id)
   (car/wcar (:redis-conn pool)
     (info (format "Destroying session %s..." id))
     (car/watch session-set-key)
@@ -504,35 +508,35 @@
                           :current-url nil
                           :webdriver-id nil})

-(s/defn model->view-model :- SessionView
+(s/defn ^:always-validate model->view-model :- SessionView
   [model :- SessionInRedis]
   (some->> model
            keywordize-keys
            (merge view-model-defaults)))

-(s/defn view-model-exists? :- s/Bool
+(s/defn ^:always-validate view-model-exists? :- s/Bool
   [pool :- SessionPool
    id   :- s/Str]
   (model-exists? (:redis-conn pool) SessionInRedis id))

-(s/defn view-model :- SessionView
+(s/defn ^:always-validate view-model :- SessionView
   [pool :- SessionPool
    id   :- s/Str]
   (-> (model (:redis-conn pool) SessionInRedis id)
       model->view-model))

-(s/defn view-models :- [SessionView]
+(s/defn ^:always-validate view-models :- [SessionView]
   [pool :- SessionPool]
   (let [redis-conn (:redis-conn pool)]
     (car/wcar redis-conn
       (car/return
         (map model->view-model (models redis-conn SessionInRedis))))))

-(s/defn view-model-ids
+(s/defn ^:always-validate view-model-ids :- [s/Str]
   [pool :- SessionPool]
   (map :id (view-models pool)))

-(s/defn view-model-by-webdriver-id :- SessionView
+(s/defn ^:always-validate view-model-by-webdriver-id :- SessionView
   "Return a view model with the corresponding webdriver id."
   [pool         :- SessionPool
    webdriver-id :- s/Str]
@@ -540,7 +544,7 @@
        (filter #(= (:webdriver-id %) webdriver-id))
        first))

-(s/defn refresh-session
+(s/defn ^:always-validate refresh-session
   [pool :- SessionPool
    id   :- s/Str]
   (car/wcar (:redis-conn pool)
@@ -568,7 +572,7 @@

 (def ^:private  refresh-sessions-lock {})

-(s/defn refresh-sessions
+(s/defn ^:always-validate refresh-sessions
   [pool :- SessionPool
    ids  :- [s/Str]]
   (locking refresh-sessions-lock
@@ -585,7 +589,8 @@
                (map :url)
                (filter identity)
                (pmap #(selenium/session-ids-from-node %))
-               (pmap #(if (not (view-model-exists? pool %))
+               (apply concat)
+               (pmap #(when-not (view-model-exists? pool %)
                         (destroy-session pool %)))))))
     true))


Schedule formatting

Schedule formatting

--- src/clj_mrazik/irc_bot.clj
+++ src/clj_mrazik/irc_bot.clj
@@ -37,7 +37,8 @@
 (defn format-schedule
     [schedule]
     (apply str (for [s schedule]
-       (str (subs (-> s :formatted :from) 0 5) "-" (subs (-> s :formatted :to) 0 5) ", "))))
+       ;(str (subs (-> s :formatted :from) 0 5) "-" (subs (-> s :formatted :to) 0 5) ", "))))
+       (str (subs (-> s :formatted :from) 0 5) "  "))))

 (defn prepare-reply-text
     [incomming-message nick input-text]


ADD REQUIRE AGAIN

ADD REQUIRE AGAIN

--- src/cljs/bmihw/submit.cljs
+++ src/cljs/bmihw/submit.cljs
@@ -1,5 +1,6 @@
 (ns bmihw.submit
   (:require [bmihw.common :refer [auth fb]]
+            [reagent-forms.core]
             [ajax.core :refer [GET]]))

 (defn update-state! [state-atom key e]


Small fixes in docs.

Small fixes in docs.

--- src/cljs/replumb/repl.cljs
+++ src/cljs/replumb/repl.cljs
@@ -412,7 +412,6 @@
     (debug-prn "Initializing REPL environment..." ))
   (assert (= cljs.analyzer/*cljs-ns* 'cljs.user))
   (set! *target* "default")
-  (swap! app-env merge (valid-opts opts))
   (set! (.. js/window -cljs -user) #js {}))

 (defn update-to-initializing
@@ -445,13 +444,12 @@
   The second parameter cb, should be a 1-arity function which receives
   the result map.

-  Therefore, given cb (fn [result] ...), the main map keys are:
-
-  ```
-  { :success? ;; a boolean indicating if everything went right
-    :value    ;; (if (success? result)) will contain the actual yield of the evaluation
-    :error    ;; (if (not (success? result)) will contain a js/Error }
-  ```
+  Therefore, given cb (fn [result-map] ...), the main map keys are:
+
+  :success? ;; a boolean indicating if everything went right
+  :value    ;; (if (success? result)) will contain the actual yield of the evaluation
+  :error    ;; (if (not (success? result)) will contain a js/Error
+  :form     ;; the evaluated form as data structure (not a string)

   It initializes the repl harness if necessary."
   [opts cb source]
@@ -460,8 +458,6 @@
           opts (valid-opts opts)
           data {:form expression-form}]
       (init-repl-if-necessary! opts cb)
-      (when (:verbose opts)
-        (debug-prn "Evaluating: " source))
       (when (:verbose opts)
         (debug-prn "Evaluating " expression-form " with options " opts))
       (binding [ana/*cljs-warning-handlers* [(partial custom-warning-handler opts cb)]]


bring back 1-word linking

bring back 1-word linking

--- src/cljs/unfolds/core.cljs
+++ src/cljs/unfolds/core.cljs
@@ -60,6 +60,24 @@
     (if (> count 100)
       (om/set-state! owner :title title)
       (om/set-state! owner :title value))))
+
+;; TODO: word-spacing (jsut add " " after 9)
+;; Doesn't work because of split-words...
+(def link-re #"\[\[([A-Za-z0-9\-]+)\|([A-Za-z0-9]+)\]\]")
+(defn link [href str] (dom/a #js {:href href} str))
+(defn link? [s] (if (re-find link-re s) true false))
+(defn get-href [s] (str (nth (re-find link-re s) 1)))
+(defn get-title [s] (str (nth (re-find link-re s) 2)))
+
+(defn str-or-link [x]
+  (if (link? x)
+    (link (str "/#/" (get-href x)) (get-title x))
+    (str " " x " ")))
+
+(defn split-words [s] (split s #"\s+"))
+
+(defn prepare-item [s]
+  (vec (map str-or-link (split-words s))))

 ;; =============================================================================
 ;; Components


Thread the onClick function in the add-points-btn

Threading macro. Cool.

--- src/cljs_leaflet/core.cljs
+++ src/cljs_leaflet/core.cljs
@@ -132,7 +132,10 @@
    [:br]
    [:input {:type "button"
             :value "Add points to Map"
-            :on-click #(time (add-points! (generate-random-points (:create-points-qty @app-state)))) }]])
+            :on-click #(-> @app-state :create-points-qty
+                           generate-random-points
+                           add-points!
+                           time) }]])

 (defn point-qty-input [ratom]
   [:input {:type "number"


even better

even better

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -63,13 +63,12 @@
   `(def ~name
      (fn ~@body)))

-(defn hinted-iterator [x]
-  (.iterator ^java.lang.Iterable x))
+(def iterator (memfn ^java.lang.Iterable iterator))

 (defmacro iterator-fn
   [& body]
   (let [[args & rest] body
-        rest (cons 'flambo.api/hinted-iterator rest)
+        rest (cons 'flambo.api/iterator rest)
         it-body (cons args (list rest))]
     `(fn ~@it-body)))

@@ -512,12 +511,12 @@
   (Note: this is currently not executed in parallel. Instead, the driver
   program computes all the elements)."
   ([rdd cnt]
-    (.takeOrdered rdd cnt))
+    (.takeOrdered rdd cnt))
   ([rdd cnt compare-fn]
-    (.takeOrdered rdd cnt
+    (.takeOrdered rdd cnt
       (if (instance? Comparator compare-fn)
         compare-fn
-        (comparator compare-fn)))))
+        (comparator compare-fn)))))

 (defmulti histogram "compute histogram of an RDD of doubles"
   (fn [_ bucket-arg] (sequential? bucket-arg)))


Update Jetty to version 9.4.44

Update Jetty to version 9.4.44

CVE-2021-34429 is fixed in version 9.4.43 but it makes sense to
update to the latest 9.x series release with further fixes.

--- ring-jetty-adapter/project.clj
+++ ring-jetty-adapter/project.clj
@@ -7,7 +7,7 @@
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [ring/ring-core "1.9.4"]
                  [ring/ring-servlet "1.9.4"]
-                 [org.eclipse.jetty/jetty-server "9.4.42.v20210604"]]
+                 [org.eclipse.jetty/jetty-server "9.4.44.v20210927"]]
   :aliases {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10" "test"]}
   :profiles
   {:dev  {:dependencies [[clj-http "3.12.3"]


need to capture compiler output as string

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -251,7 +251,7 @@
          (let [form (r/read {:eof eof} rdr)]
            (if-not (identical? eof form)
              (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
-                   ast  (.append sb (comp/emit (ana/analyze aenv form)))]
+                   ast  (.append sb (with-out-str (comp/emit (ana/analyze aenv form))))]
                (if (= :ns (:op ast))
                  (ns-side-effects bound-vars aenv ast opts
                    (fn [_] (compile-loop)))
@@ -287,7 +287,7 @@
          (let [form (r/read {:eof eof} rdr)]
            (if-not (identical? eof form)
              (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))
-                   ast  (.append sb (comp/emit (ana/analyze aenv form)))]
+                   ast  (.append sb (with-out-str (comp/emit (ana/analyze aenv form))))]
                (if (= :ns (:op ast))
                  (ns-side-effects bound-vars aenv ast opts
                    (fn [_] (compile-loop)))


Fix bug in `list-active` function of modules Manager.

--- src/containium/modules.clj
+++ src/containium/modules.clj
@@ -111,8 +111,8 @@
   Manager
   (list-active [_]
     (into {} (keep (fn [[name agent]]
-                     (let [state (:state agent)]
-                       (when-not (= :undeployed state)
+                     (let [state (:state @agent)]
+                       (when (not= :undeployed state)
                          [name state])))
                    @agents)))


extract to method - atom dont change value?

--- src/hackerrank/compare_the_triplets.clj
+++ src/hackerrank/compare_the_triplets.clj
@@ -5,39 +5,46 @@

 ; https://www.hackerrank.com/challenges/compare-the-triplets

+(defn parseInt [n]
+	(Integer/parseInt n))

-(def max-points 100)
-(def alice (atom 0))
-(def bob (atom 0))
+(defn compare-triplets [first-line second-line]
+  (let [a0_temp first-line
+        a0_t (split a0_temp #"\s+")
+        a0 (parseInt (a0_t 0))
+        a1 (parseInt (a0_t 1))
+        a2 (parseInt (a0_t 2))

-;; https://clojuredocs.org/clojure.core/swap!
-;; https://clojuredocs.org/clojure.core/cond
-(defn score [a b]
-  (cond (and (> (compare a b) 0) (< @alice max-points)) (swap! alice inc)
-        (and (< (compare a b) 0) (< @bob max-points)) (swap! bob inc)))
+        b0_temp second-line
+        b0_t (split b0_temp #"\s+")
+        b0 (parseInt (b0_t 0))
+        b1 (parseInt (b0_t 1))
+        b2 (parseInt (b0_t 2))

-(let [a0_temp "5 6 7" ; (read-line)
-      a0_t (split a0_temp #"\s+")
-      a0 (Integer/parseInt (a0_t 0))
-      a1 (Integer/parseInt (a0_t 1))
-      a2 (Integer/parseInt (a0_t 2))
+        max-points 100
+        alice (atom 0)
+        bob (atom 0)]

-      b0_temp "3 6 10" ;(read-line)
-      b0_t (split b0_temp #"\s+")
-      b0 (Integer/parseInt (b0_t 0))
-      b1 (Integer/parseInt (b0_t 1))
-      b2 (Integer/parseInt (b0_t 2))]
+    (defn score [a b]
+      ;; https://clojuredocs.org/clojure.core/cond
+      (defn inc-points [person]
+        (swap! person inc))

-  ;; https://clojuredocs.org/clojure.string/join
-  (println (join " " [a0 a1 a2]))
-  (println (join " " [b0 b1 b2]))
+      ;; https://clojuredocs.org/clojure.core/swap!
+      (cond (and (> (compare a b) 0) (< @alice max-points)) (swap! alice inc)
+            (and (< (compare a b) 0) (< @bob max-points)) (swap! bob inc)))

-  (score a0 b0)
-  (score a1 b1)
-  (score a2 b2)
+    ;; https://clojuredocs.org/clojure.string/join
+    (println (join " " [a0 a1 a2]))
+    (println (join " " [b0 b1 b2]))

-  (println @alice @bob)
-)
+    (score a0 b0)
+    (score a1 b1)
+    (score a2 b2)
+
+    (join " " [@alice @bob])))
+
+(println (compare-triplets "5 6 7" "3 6 10"))

 ;; 2016-07-29 17:04
 ;; 1/7 points


updated clojure tests with real words

updated clojure tests with real words

--- assignments/clojure/anagram/anagram_test.clj
+++ assignments/clojure/anagram/anagram_test.clj
@@ -5,10 +5,10 @@
   (is (= [] (anagram/anagrams-for "diaper" ["hello" "world" "zombies" "pants"]))))

 (deftest detect-simple-anagram
-  (is (= ["ab"] (anagram/anagrams-for "ba" ["ab" "abc" "bac"]))))
+  (is (= ["tan"] (anagram/anagrams-for "ant" ["tan" "stand" "at"]))))

 (deftest does-not-confuse-different-duplicates
-  (is (= [] (anagram/anagrams-for "abb" ["baa"]))))
+  (is (= [] (anagram/anagrams-for "galea" ["eagle"]))))

 (deftest detect-anagram
   (is (= ["inlets"] (anagram/anagrams-for "listen" ["enlists" "google" "inlets" "banana"]))))


Sort the import reports

Sort the import reports

--- src/mdr2/abacus/import.clj
+++ src/mdr2/abacus/import.clj
@@ -246,65 +246,65 @@
   (println)
   (println "Ready:" (count (filter ready? all-productions)))
   (println "------")
-  (println (string/join ", " (map :id (filter ready? all-productions))))
+  (println (string/join ", " (sort (map :id (filter ready? all-productions)))))
   (println)
   (println "Archived:" (count (filter archived? all-productions)))
   (println "---------")
   (println)
   (println "Recording with no wav and a struct.html:" (count (filter #(recording-no-wav-with-struct? %) all-productions)))
   (println "----------------------------------------")
-  (println (string/join ", " (map :id (filter #(recording-no-wav-with-struct? %) all-productions))))
+  (println (string/join ", " (sort (map :id (filter #(recording-no-wav-with-struct? %) all-productions)))))
   (println)
   (let [weird (filter #(and (not-any? struct-file? (get-all-files %)) (recording-no-wav? %)) all-productions)]
     (println "Recording with no wav and no struct.html:" (count weird))
     (println "-----------------------------------------")
-    (println (string/join ", " (map :id weird))))
+    (println (string/join ", " (sort (map :id weird)))))
   (println)
   (println "Recording with wav and an obi project:" (count (filter recording-with-obi? all-productions)))
   (println "--------------------------------------")
-  (println (string/join ", " (map :id (filter recording-with-obi? all-productions))))
+  (println (string/join ", " (sort (map :id (filter recording-with-obi? all-productions)))))
   (println)
   (println "Recording with wav and no obi project:" (count (filter recording-with-wav-no-obi? all-productions)))
   (println "--------------------------------------")
-  (println (string/join ", " (map :id (filter recording-with-wav-no-obi? all-productions))))
+  (println (string/join ", " (sort (map :id (filter recording-with-wav-no-obi? all-productions)))))
   (println)
   (print "Ignoring the rest: ")
   (println (dissoc (frequencies (map :state all-productions)) "archived" "recording" "ready"))
   (println "------------------")
   (doseq [state ["repairing" "finishing" "recorded" "pre_ready"]]
-    (println (str (string/capitalize state) ":") (string/join ", " (map :id (filter #(= (:state %) state) all-productions)))))
+    (println (str (string/capitalize state) ":") (string/join ", " (sort (map :id (filter #(= (:state %) state) all-productions))))))
   (println )
   (println "Importing commercial audio books")
   (println "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
   (println)
   (println "Ready:" (count (filter ready? all-commercial-productions)))
   (println "------")
-  (println (string/join ", " (map :id (filter ready? all-commercial-productions))))
+  (println (string/join ", " (sort (map :id (filter ready? all-commercial-productions)))))
   (println)
   (println "Archived:" (count (filter archived? all-commercial-productions)))
   (println "---------")
   (println)
   (println "Recording with no wav and a struct.html:" (count (filter #(recording-no-wav-with-struct? %) all-commercial-productions)))
   (println "----------------------------------------")
-  (println (string/join ", " (map :id (filter #(recording-no-wav-with-struct? %) all-commercial-productions))))
+  (println (string/join ", " (sort (map :id (filter #(recording-no-wav-with-struct? %) all-commercial-productions)))))
   (println)
   (let [weird (filter #(and (recording-no-wav? %)) all-commercial-productions)]
     (println "Recording with no wav:" (count weird))
     (println "----------------------")
-    (println (string/join ", " (map :id weird))))
+    (println (string/join ", " (sort (map :id weird)))))
   (println)
   (println "Recording with wav and an obi project:" (count (filter recording-with-obi? all-commercial-productions)))
   (println "--------------------------------------")
-  (println (string/join ", " (map :id (filter recording-with-obi? all-commercial-productions))))
+  (println (string/join ", " (sort (map :id (filter recording-with-obi? all-commercial-productions)))))
   (println)
   (println "Recording with wav and no obi project:" (count (filter recording-with-wav-no-obi? all-commercial-productions)))
   (println "--------------------------------------")
-  (println (string/join ", " (map :id (filter recording-with-wav-no-obi? all-commercial-productions))))
+  (println (string/join ", " (sort (map :id (filter recording-with-wav-no-obi? all-commercial-productions)))))
   (println)
   (print "Ignoring the rest: ")
   (println (dissoc (frequencies (map :state all-commercial-productions)) "archived" "recording" "ready"))
   (println "------------------")
   (doseq [state ["structuring" "wipsing"]]
-    (println (str (string/capitalize state) ":") (string/join ", " (map :id (filter #(= (:state %) state) all-commercial-productions)))))
+    (println (str (string/capitalize state) ":") (string/join ", " (sort (map :id (filter #(= (:state %) state) all-commercial-productions))))))
   (println )
 )


cosmetics

cosmetics

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -4,7 +4,7 @@
   (:require [clojure.tools.cli :as cli   ])
   (:gen-class))

-(declare nmlget nmlname nmlset nmlstr)
+(declare nml-get nml-name nml-set nml-str)

 ; defs

@@ -18,33 +18,33 @@
   (if msg (println (apply str msg)))
   (System/exit 1))

-(defn nmlget [tree nml key]
-  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
-        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
+(defn nml-get [tree nml key]
+  (let [stmt     (last (filter #(= (nml-name %) nml) (rest tree)))
+        nvsubseq (last (filter #(= (nml-name %) key) (rest (last stmt))))
         values   (last nvsubseq)
-        value    (if (nil? values) "" (nmlstr values))]
+        value    (if (nil? values) "" (nml-str values))]
     (println (str nml ":" key "=" value))
     tree))

-(defn nmlname [x]
-  (nmlstr (second x)))
+(defn nml-name [x]
+  (nml-str (second x)))

-(defn nmlset [tree nml key val & sub]
+(defn nml-set [tree nml key val & sub]
   (let [child (if sub :nvsubseq :stmt)
         match (if sub key nml)
-        vnew  (if sub (fn [tree] (parse val :start :values)) #(nmlset % nml key val true))
-        f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
+        vnew  (if sub (fn [tree] (parse val :start :values)) #(nml-set % nml key val true))
+        f     (fn [k v] [child k (if (= (nml-str k) match) (vnew v) v)])]
     (insta/transform {child f} tree)))

-(defn nmlstr [x]
+(defn nml-str [x]
   (let [k (first x)
         v (rest  x)
         cjoin    #(string/join "," %)
-        delegate #(map nmlstr %)
-        ds       (fn [v] (delegate (sort-by #(nmlname %) v)))
-        list2str #(apply str (map nmlstr %))
-        sf       #(nmlstr (first %))
-        sl       #(nmlstr (last %))]
+        delegate #(map nml-str %)
+        ds       (fn [v] (delegate (sort-by #(nml-name %) v)))
+        list2str #(apply str (map nml-str %))
+        sf       #(nml-str (first %))
+        sl       #(nml-str (last %))]
     (if debug (println (str "k=" k " v=" v)))
     (apply str (case k
                  :s        (ds v)
@@ -83,16 +83,16 @@
                  :ws       ""
                  :wsopt    ""))))

-(defn nmlxform [tree sets]
+(defn nml-tree [fname]
+  (try (parse (slurp fname))
+       (catch Exception e (fail "Could not open namelist file '" fname "'."))))
+
+(defn nml-xform [tree sets]
   (loop [t tree s sets]
     (if (empty? s)
       t
       (let [[nml key val] (first s)]
-        (recur (nmlset t nml key val) (rest s))))))
-
-(defn nmltree [fname]
-  (try (parse (slurp fname))
-       (catch Exception e (fail "Could not open namelist file '" fname "'."))))
+        (recur (nml-set t nml key val) (rest s))))))

 ;; cli

@@ -108,8 +108,8 @@
   (string/split x #":" 2))

 (defn parse-set [x]
-  (let [[nmlkey val] (string/split x #"=" 2)
-        [nml key] (parse-get nmlkey)]
+  (let [[nml+key val] (string/split x #"=" 2)
+        [nml key] (parse-get nml+key)]
     [nml key val]))

 (def cliopts
@@ -123,8 +123,8 @@
   (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
         gets (:get options)
         sets (:set options)
-        tree (nmltree (first arguments))]
+        tree (nml-tree (first arguments))]
     (if (and gets sets) (fail "Do not mix get and set operations."))
-    (cond gets (doseq [[nml key] gets] (nmlget tree nml key))
-          sets (println (nmlstr (nmlxform tree sets)))
-          :else (println (nmlstr tree)))))
+    (cond gets (doseq [[nml key] gets] (nml-get tree nml key))
+          sets (println (nml-str (nml-xform tree sets)))
+          :else (println (nml-str tree)))))


Minor updates

Minor updates

--- src/angelic/scripts/experiments_11icaps.clj
+++ src/angelic/scripts/experiments_11icaps.clj
@@ -121,7 +121,7 @@
    (experiments/make-experiment-set
     "ib-taxi"
     [:product
-     [:run        [1  2  3]]
+     [:run        [1  ]]
      [:size (vec (range 1 16))]
      [:constrain? [true false]]
      [:alg (      keys taxi-algs)]
@@ -134,22 +134,64 @@
     (fn [m] `(textbook/uniform-cost-search ~'init))
     'angelic.scripts.experiments-11icaps 10 3600 512 false ::ExpResult))

-
-(comment
-;;;;;;; miconic
-
- (def miconic-algs
-      [[[:baseline] "base"]
-       [[:asplan] "bi"]])
-
-
-
- (defonce *results* nil)
- (defn read-results []
-   (def *results*
+(defn make-taxi-exp-set-single []
+   (experiments/make-experiment-set
+    "ib-taxi-single"
+    [:product
+     [:run        [6]]
+     [:size (vec (range 1 11))]
+     [:constrain? [true false]]
+     [:alg (      keys taxi-algs)]
+     [:type [:single]]]
+    (fn [m]
+      (let [instance-form `((taxi-factories ~(:type m)) 3 3 ~(:size m) ~(:constrain? m) ~(:run m))]
+        (if (= (:alg m) :baseline)
+          instance-form
+          `(asplan/make-asplan-env ~instance-form))))
+    (fn [m] `(textbook/uniform-cost-search ~'init))
+    'angelic.scripts.experiments-11icaps 10 3600 512 false ::ExpResult))
+
+
+
+(defonce *taxi-results* nil)
+(defn read-taxi-results []
+  (def *taxi-results*
+       (doall
         (experiments/experiment-set-results->dataset
-         (experiments/read-experiment-set-results (make-exp-set))))))
-
+         (experiments/read-experiment-set-results (make-taxi-exp-set))))))
+
+(def *alg-order*
+     [[[:baseline false] "Baseline"]
+      [[:baseline true] "Baseline + constraint"]
+      [[:asplan false] "Bounded Intention"]
+      [[:asplan true] "Bounded Intention + constraint"]])
+
+(def *alg-names* (into {} *alg-order*))
+
+(defn order [things key-fn desired-order]
+  (let [m (group-by key-fn things)]
+    (keep #(first (get m %)) desired-order)))
+
+(defn make-taxi-charts []
+  (doseq [[type-key name] taxi-types]
+    (charts/plot
+     (datasets/ds->chart
+      (filter (datasets/ds-fn [type output constrain? alg]
+                              (and output (= type type-key)
+                                   (if (= type :pairwise)
+                                     constrain?
+                                     (or (not constrain?) (= alg :baseline)))))
+              *taxi-results*)
+      [:alg :constrain?] :size :next-count
+      {:term "solid dashed size 3.0, 2.0"
+       :ylog true :key (if (= type-key :independent) "top right" "bottom right")
+       :xlabel "# passengers" :ylabel "# states to optimal solution"
+       :title (str name " taxi")
+       }
+      (fn [[alg constrain?]] (let [v (cond (= alg :asplan) 1 constrain? 3 :else 2)] {:lw 3 :pt v :lt v}))
+      *alg-names*  #_ #(let [n (first %)] (if (= (last n) \U) (apply str (concat (drop-last n) "-UCS")) (str n "*")))
+      #(order % :title (map second *alg-order*))
+      #_ (str "/Users/jawolfe/Projects/reports/11-icaps/graphs/" name ".pdf")))))

@@ -159,7 +201,6 @@
 (comment
  (def *alg-order* ["H-UCS" "DH-UCS" "DSH-UCS" "AHA*" "DAHA*" "DASHA*"])
  (defn order [things key-fn desired-order]
-                                        ;  (println things)
    (let [m (group-by key-fn things)]
      (map #(first (util/safe-get m %)) desired-order)))


undo refactoring and do the 'nav-point' check within the 'when'

--- src-cljs/frontend/components/pieces/page_header.cljs
+++ src-cljs/frontend/components/pieces/page_header.cljs
@@ -261,7 +261,10 @@
                                                                                :properties {:component "topbar"
                                                                                :treatment "top-bar-beta"}})}
                       "Provide Beta UI Feedback")])])
-              (when (and (false? om-next-page?) (false? show-nux-experience?))
+              (when (and (false? om-next-page?)
+                         (or (false? show-nux-experience?)
+                             (and (true? show-nux-experience?)
+                                  (not= (:nav-point topbar-beta) :dashboard))))
                 (button/link {:fixed? true
                               :kind (if has-topbar?
                                       :secondary


Improve log output in FMI Testbed image download

--- src/env_logger/grabber.clj
+++ src/env_logger/grabber.clj
@@ -79,15 +79,15 @@
   (let [tb-resp (try
                   (client/get "http://testbed.fmi.fi")
                   (catch Exception e
-                    (log/error "Testbed image fetch failed: HTTP status code"
-                               (:status (ex-data e)))))]
+                    (log/error (str "Testbed image fetch failed: message "
+                                    (.getMessage e)))))]
     (if (not= 200 (:status tb-resp))
       (log/error "Testbed page load failed")
       (let [jsoup-doc (Jsoup/parse (:body tb-resp))
             img-src (.attr (.select jsoup-doc "img[src^=data/area]") "src")]
         (if (empty? img-src)
-          (log/error "Testbed image fetch failed: image element"
-                     "src was empty")
+          (log/error (str "Testbed image fetch failed: image element"
+                          " src was empty"))
           (let [resp (client/get (str "http://testbed.fmi.fi/" img-src)
                                  {:as :byte-array})]
             (if (not= 200 (:status resp))


Fixed BOOT_EMIT_TARGET warning message

Fixed BOOT_EMIT_TARGET warning message

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -789,7 +789,7 @@
     (let [fs      (commit! (reset-fileset))
           target? (not= "no" (boot.App/config "BOOT_EMIT_TARGET"))
           depr    (delay (util/warn-deprecated "Implicit target dir is deprecated, please use the target task instead.\n")
-                         (util/warn-deprecated "Set BOOT_EMIT_TARGET='no' to disable implicit target dir.\n"))
+                         (util/warn-deprecated "Set BOOT_EMIT_TARGET=no to disable implicit target dir.\n"))
           sync!   (if-not target?
                     identity
                     (comp (fn [_] @depr)


Fix card top shadow being cut-off

Fix card top shadow being cut-off

--- src/braid/core/client/ui/styles/thread.cljs
+++ src/braid/core/client/ui/styles/thread.cljs
@@ -115,7 +115,9 @@
    ; switch to ::after to align at top
    [:&::before
     {:content "\"\""
-     :flex-grow 1}]
+     :flex-grow 1
+     ; have 1px so card shadow shows
+     :min-height "1px"}]

    ;; XXX: does this class actually apply to anything?
    [:&.archived :&.limbo :&.private


rename visit for topological sort

rename visit for topological sort

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -489,11 +489,11 @@

 (def module-dependencies (modules->dependency-graph modules))

-(defn visit
+(defn post-order-visit
   [{:keys [graph not-visited sorted] :as dfs} node]
   (if (not-visited node)
     (->
-      (reduce visit
+      (reduce post-order-visit
         (update dfs :not-visited disj node)
         (get graph node []))
       (update :sorted conj node))
@@ -504,7 +504,7 @@
   (some
     #(if (-> % :not-visited empty?) (:sorted %))
     (iterate
-      #(visit % (-> % :not-visited first))
+      #(post-order-visit % (-> % :not-visited first))
       {:graph graph
        :not-visited (set (keys graph))
        :sorted []})))


* impl.connection   - added `connect-url` for connecting to a specific debugger url   - refactored `connect`     - pick the first inspectable *page*, to avoid picking a non-page debug target     - defers actual connection logic to `connect-url`   - added `inspectable-pages`, which gives the full list of pages available for use with devtools

--- src/clj_chrome_devtools/impl/connection.clj
+++ src/clj_chrome_devtools/impl/connection.clj
@@ -27,7 +27,7 @@
   (let [[domain event] (map (comp keyword camel->clojure)
                             (str/split (:method msg) #"\."))
         event {:domain domain
-               :event event
+               :event  event
                :params (:params msg)}]
     (async/go
       (async/>! event-chan event))))
@@ -54,18 +54,9 @@
       (log/error "Exception in devtools WebSocket receive, msg: " msg
                  ", throwable: " t))))

-(defn- fetch-ws-debugger-url [host port]
-  (let [response @(http/get (str "http://" host ":" port "/json/list"))
-        url (some-> response :body parse-json first :web-socket-debugger-url)]
-    (when-not url
-      (throw (ex-info "No chrome remote debugging URL found"
-                      {:host host :port port
-                       :response response})))
-    url))
-
 (defn- wait-for-remote-debugging-port [host port max-wait-time-ms]
   (let [wait-until (+ (System/currentTimeMillis) max-wait-time-ms)
-        url (str "http://" host ":" port "/json/version")]
+        url        (str "http://" host ":" port "/json/version")]
     (loop [response @(http/head url)]
       (cond
         (= (:status response) 200)
@@ -73,41 +64,73 @@

         (> (System/currentTimeMillis) wait-until)
         (throw (ex-info "Chrome remote debugging port not up"
-                        {:host host :port port
+                        {:host             host :port port
                          :max-wait-time-ms max-wait-time-ms}))

         :default
         (do (Thread/sleep 100)
             (recur @(http/head url)))))))

+(defn inspectable-pages
+  "Collect the list of inspectable pages returned by the DevTools protocol."
+  ([host port]
+    (inspectable-pages host port 1000))
+  ([host port max-wait-time-ms]
+   (wait-for-remote-debugging-port host port max-wait-time-ms)
+   (let [response @(http/get (str "http://" host ":" port "/json/list"))]
+     (some->> response
+              :body
+              parse-json))))
+
+
+(defn- first-inspectable-page [pages]
+  (or (some->> pages
+               (filter (comp #{"page"} :type))
+               (keep :web-socket-debugger-url)
+               first)
+      (throw (ex-info "No debuggable pages found"
+                      {:pages pages}))))
+
+(defn connect-url
+  "Establish a websocket connection to web-socket-debugger-url, as given by
+   inspectable-pages."
+  [web-socket-debugger-url]
+  (assert web-socket-debugger-url)
+  (let [client     (ws/client)
+        ;; Request id to callback
+        requests   (atom {})
+
+        ;; Event pub/sub channel
+        event-chan (async/chan)
+        event-pub  (async/pub event-chan (juxt :domain :event))]
+
+    ;; Configure max message size to 1mb (default 64kb is way too small)
+    (doto (.getPolicy client)
+      (.setMaxTextMessageSize (* 1024 1024)))
+
+    (.start client)
+    (->Connection (ws/connect web-socket-debugger-url
+                              :on-receive (partial on-receive requests event-chan)
+                              :client client)
+                  requests
+                  event-chan
+                  event-pub)))
+
 (defn connect
-  "Connect to a running headless Chrome "
-  ([] (connect "localhost" 9222))
-  ([host port] (connect host port nil))
+  "Establish a websocket connection to the DevTools protocol at host:port.
+   Selects the first inspectable page returned; to attach to a specific page,
+   see connect-url. Initial connection will be retried for up to
+   max-wait-time-ms milliseconds (default 1000) before giving up."
+  ([]
+   (connect "localhost" 9222))
+  ([host port]
+   (connect host port 1000))
   ([host port max-wait-time-ms]
    (when max-wait-time-ms
      (wait-for-remote-debugging-port host port max-wait-time-ms))
-   (let [client (ws/client)
-         url (fetch-ws-debugger-url host port)
-
-         ;; Request id to callback
-         requests (atom {})
-
-         ;; Event pub/sub channel
-         event-chan (async/chan)
-         event-pub (async/pub event-chan (juxt :domain :event))]
-
-     ;; Configure max message size to 1mb (default 64kb is way too small)
-     (doto (.getPolicy client)
-       (.setMaxTextMessageSize (* 1024 1024)))
-
-     (.start client)
-     (->Connection (ws/connect url
-                     :on-receive (partial on-receive requests event-chan)
-                     :client client)
-                   requests
-                   event-chan
-                   event-pub))))
+    (let [url (-> (inspectable-pages host port)
+                  (first-inspectable-page))]
+      (connect-url url))))

 (defn send-command [{requests :requests con :ws-connection} payload id callback]
   (swap! requests assoc id callback)


Add :prfPrdLiquidsNetMillSm3 property

Add :prfPrdLiquidsNetMillSm3 property

--- src/clj_simple_chart/ncs/raw_production.clj
+++ src/clj_simple_chart/ncs/raw_production.clj
@@ -11,6 +11,7 @@
 ; * filled gaps
 ; * appended 11 empty entries for shut down fields
 ; * prev-rows property containing 12 last months of same field
+; * :prfPrdLiquidsNetMillSm3 which is the sum of :prfPrdOilNetMillSm3 :prfPrdNGLNetMillSm3 :prfPrdCondensateNetMillSm3

 (defn year-month [s]
   {:pre [(string? s)]}
@@ -99,6 +100,7 @@
                         (map #(assoc % :date (str (format "%04d-%02d" (:prfYear %) (:prfMonth %)))))
                         (map #(assoc % :date-int (+ (* 100 (:prfYear %)) (:prfMonth %))))
                         (map #(assoc % :prev-months (prev-12-months (:date %))))
+                        (map #(assoc % :prfPrdLiquidsNetMillSm3 (reduce + 0 (mapv % [:prfPrdOilNetMillSm3 :prfPrdNGLNetMillSm3 :prfPrdCondensateNetMillSm3]))))
                         (sort-by :date)
                         (vec)))


Migrate a couple of queries

Migrate a couple of queries

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -140,11 +140,8 @@
    specified. Also, since a row only exists when it contains one value for a column not part of
    the primary key, one such value must be specified too."
   [^Session session & query-params]
-
-  (cc/execute session
-              (apply new-query-api/insert query-params)
-              ;; (compile-query- q/insert-query query-params)
-              ))
+  (cc/execute session
+              (apply new-query-api/insert query-params)))

 (defn insert-async
   "Same as insert but returns a future"
@@ -184,7 +181,9 @@
    Other columns values are specified through assignment within the `set` clause."
   [^Session session & query-params]
   (cc/execute session
-              (compile-query- q/update-query query-params)))
+              (apply new-query-api/update query-params)
+              ;; (compile-query- q/update-query query-params)
+              ))

 (defn update-async
   "Same as update but returns a future"


Start outlining the gap-consolidation function

This is really just another baby-step

--- src/clojure/frereth_cp/message/to_child.clj
+++ src/clojure/frereth_cp/message/to_child.clj
@@ -18,6 +18,40 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal Helpers

+;; The caller needs to verify that the gap-buffer's start
+;; is < receive-bytes.
+;; Well, it does, because it can short-circuit a reduce
+;; if that's the case.
+;; It seems like it would be nice to be able to spec that
+;; here for the sake of generative testing.
+;; I think I can get away with s/and, though I'll probably
+;; be forced to get fancy with the generator
+;; TODO: Ask about how.
+(s/fdef consolidate-message-block
+        :args (s/cat :incoming ::specs/incoming
+                     :gap-buffer (s/tuple ::specs/gap-buffer-key ::specs/buf))
+        :ret ::specs/incoming)
+(defn consolidate-message-block
+  "Move the parts of the gap-buffer that are ready to write to child"
+  [{:keys [::specs/->child-buffer
+           ::specs/receive-bytes]
+    :as incoming}
+   [[[start stop]
+     :as gap-buffer-key]
+    buf]]
+  ;; For now, this top-level if check is redundant.
+  ;; I'd rather be safe and trust the JVM that remove it
+  ;; under the assumption that callers will be correct.
+  ;; Even though I'm the only caller at the moment, this
+  ;; is a detail I don't trust in myself.
+  (if (<= start receive-bytes)
+    ;; Q: Did a previous message overwrite this message block?
+    (if (<= stop receive-bytes)
+      ;; Skip this message block
+      (update incoming ::specs/gap-buffer (partial drop 1))
+      ;; Consolidate this message block
+      (throw (RuntimeException. "Write this")))))
+
 (s/fdef consolidate-gap-buffer
         :args (s/cat :state ::specs/state)
         :ret ::specs/state)
@@ -27,10 +61,22 @@
   ;; which seems like a better choice.
   [{:keys [::specs/incoming]
     :as state}]
-  (let [{:keys [::specs/->child-buffer
-                ::specs/gap-buffer
-                ::specs/receive-bytes]} incoming]
-    (throw (RuntimeException. "Write this"))))
+  ;; TODO: Needs unit tests!
+  ;; This seems to be begging for generative testing
+  (let [{:keys [::specs/gap-buffer]} incoming]
+    (assoc state
+           ::specs/incoming
+           (reduce (fn [{:keys [::specs/->child-buffer
+                                ::specs/receive-bytes]
+                         :as acc}
+                        [[[start stop] k] buf]]
+                     ;; Q: Have we filled an existing gap?
+                     (if (<= start receive-bytes)
+                       (consolidate-message-block acc buf)
+                       ;; There's another gap. Move on
+                       (reduced acc)))
+                   incoming
+                   gap-buffer))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


Fixed concept validation.

Fixed concept validation.

--- src/cmr/metadata_db/services/concept_validations.clj
+++ src/cmr/metadata_db/services/concept_validations.clj
@@ -21,12 +21,12 @@
 (defn concept-id-validation
   [concept]
   (when-let [concept-id (:concept-id concept)]
-    (cc/concept-id-validation concept-id)))
+    (cc/validate-concept-id concept-id)))

 (defn concept-id-match-fields-validation
   [concept]
   (when-let [concept-id (:concept-id concept)]
-    (when-not (cc/concept-id-validation concept-id)
+    (when-not (cc/validate-concept-id concept-id)
       (let [{:keys [concept-type provider-id]} (cc/parse-concept-id concept-id)]
         (when-not (and (= concept-type (:concept-type concept))
                        (= provider-id (:provider-id concept)))


Minor enhancements to filter-file in clojure

--- clojure/cljsearch/src/cljsearch/searcher.clj
+++ clojure/cljsearch/src/cljsearch/searcher.clj
@@ -142,15 +142,19 @@
     (or
       (not (:excludehidden settings))
       (not (hidden-file? f)))
-    (or
+    (if
+      (archive-file? f)
       (and
-        (archive-file? f)
         (:searcharchives settings)
-        (is-archive-search-file? f settings))
+        (is-archive-search-file? f settings)
+      )
       (and
-        (not (archive-file? f))
         (not (:archivesonly settings))
-        (is-search-file? f settings)))))
+        (is-search-file? f settings)
+      )
+    )
+  )
+)

 (defn get-search-files-for-directory [d settings]
   (vec (filter #(filter-file? % settings) (get-files-in-directory d))))