Test tweaks

Test tweaks

--- src/cljs/bookmarx/home.cljs
+++ src/cljs/bookmarx/home.cljs
@@ -51,6 +51,7 @@
                 show-visited sort-on]} @settings
         new-ticks (- (. js/Date (now)) (* (get-cookie :new-hours) ticks-in-hour))
         last-visited-ticks (- (. js/Date (now)) (* (get-cookie :last-visited-hours) ticks-in-hour))]
+    ;; Links
     (if url
       [:div.bookmark_children {:key (str id "-key")}
        (if icon
@@ -63,7 +64,7 @@
                                  :href (path "/add")}])
        (when show-title
         [:a.bookmark {:on-click #(link-click id url) :key (str id "-link-key")} title])
-       (when show-url [:dfn url])
+       (when show-url [:a.text-muted {:on-click #(link-click id url) :key (str id "-url-key")} url])
        (when (and show-rating rating)
          (for [i (range 0 rating)]
            [:span.bookmark_link-icon-rating {:aria-hidden "true" :key (str id "-rating" i "-key")}]))
@@ -74,8 +75,9 @@
          [:span.bookmark-new])
        (when (and show-visited last-visited (> (.getTime (parse-date last-visited)) last-visited-ticks))
          [:span.bookmark-visited])]
+      ;; Folders
       (let [{:keys [bookmark/children bookmark/title bookmark/link-count open?]} (session/get id)]
-        (when-not (and (empty? children) (= id (session/get :active)))
+        (when (and (not= id (session/get :active)) (or (not (empty? children)) (= id -1)))
           [:div.bookmark_children {:key (str id "-key")}
            [:span {:class (str "bookmark_arrow" (when (not open?) "-collapsed"))
                    :key (str id "-arrow-key")


cleanup

cleanup

--- src/cljs/demtools/core.cljs
+++ src/cljs/demtools/core.cljs
@@ -25,12 +25,11 @@
          :count 0
          :file/results ""}))

-(js/console.log "hi")
 (def w (js/Worker. "js/compiled/demtools-worker.js"))
 (set! (.-onmessage w)
       (fn [& e] (js/console.log "received" e)))
 (.postMessage w "hi guy")
-(js/console.log "hi" w)
+

 (defmulti read (fn [& args] (namespace (apply om/dispatch args))))
 (defn direct-read [state k] {:value (get @state k nil)})


more preconditions

more preconditions

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -92,6 +92,7 @@
    :looser :red,
    :taken [[8 5] [9 5]]}"
   [board [xi yi :as move] [dx dy]]
+  {:pre [(board? board)]}
   (loop [x (+ xi dx)
          y (+ yi dy)
          looser nil
@@ -125,6 +126,7 @@
 (defn available-moves-xf
   "Transducer to get available moves on the map"
   [board]
+  {:pre [(board? board)]}
   (comp
     (filter #(= (get-in board %) :empty))
     (mapcat #(available-moves-at board %))
@@ -141,6 +143,7 @@
        :looser :red,
        :taken [[0 4]]})}}"
   [{:keys [board] :as game}]
+  {:pre [(board? board)]}
   (assoc game :moves
     (transduce
       (available-moves-xf board)
@@ -184,6 +187,7 @@
 (defn play-move
   "On player playing the move [x y] - update all the game state accordingly"
   [{:keys [player board] :as game} point]
+  {:pre [(board? board)]}
   (if-let [moves (get-move-at game player point)]
     (->
       (reduce apply-move game moves)


Fix use of wrong unit-type label

Fix use of wrong unit-type label

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -400,7 +400,7 @@
                           armor-type-abbrev]

                          :unit-type.armor-type/armored
-                         [:abbr {:title (translate :personnel-name)
+                         [:abbr {:title (translate :armored-name)
                                  :style {:cursor "inherit"}}
                           armor-type-abbrev]


Add support for setMaxConnectionAge in db connection

--- src/com/puppetlabs/jdbc.clj
+++ src/com/puppetlabs/jdbc.clj
@@ -145,7 +145,7 @@
   [{:keys [classname subprotocol subname username password
            partition-conn-min partition-conn-max partition-count
            stats log-statements log-slow-statements
-           conn-max-age conn-keep-alive]
+           conn-max-age conn-idle-max-age conn-keep-alive]
     :or   {partition-conn-min  1
            partition-conn-max  50
            partition-count     1
@@ -154,7 +154,8 @@
            ;;  be in the config file and we're manually converting it to a boolean
            log-statements      "true"
            log-slow-statements 10
-           conn-max-age        60
+           conn-max-age        0
+           conn-idle-max-age   60
            conn-keep-alive     240}
     :as   db}]
   ;; Load the database driver class
@@ -167,7 +168,8 @@
                           (.setMaxConnectionsPerPartition partition-conn-max)
                           (.setPartitionCount partition-count)
                           (.setStatisticsEnabled stats)
-                          (.setIdleMaxAgeInMinutes conn-max-age)
+                          (.setMaxConnectionAge conn-max-age, TimeUnit/MINUTES)
+                          (.setIdleMaxAgeInMinutes conn-idle-max-age)
                           (.setIdleConnectionTestPeriodInMinutes conn-keep-alive)
                           ;; paste the URL back together from parts.
                           (.setJdbcUrl (str "jdbc:" subprotocol ":" subname))


Temporarily disable this test

Temporarily disable this test

--- test/circle/backend/build/test_email.clj
+++ test/circle/backend/build/test_email.clj
@@ -21,10 +21,14 @@
                           (successful-action "2")
                           (successful-action "3")]}))

-(fact "notify email works"
-  (build/successful? (run-build (minimal-build :actions [(successful-action "1")]
-                                               :notify_emails ["foo@bar.com"
-                                                              "baz@bar.com"]))) => truthy
-  (provided
-    (circle.backend.email/send :to "foo@bar.com" :subject anything :body anything) => anything :times 1
-    (circle.backend.email/send :to "baz@bar.com" :subject anything :body anything) => anything :times 1))+;;
+;; This test 'works', but we temporarily hard coded all emails to go to us, rather than customers, so the test fails.
+;;
+
+;; (fact "notify email works"
+;;   (build/successful? (run-build (minimal-build :actions [(successful-action "1")]
+;;                                                :notify_emails ["foo@bar.com"
+;;                                                               "baz@bar.com"]))) => truthy
+;;   (provided
+;;     (circle.backend.email/send :to "foo@bar.com" :subject anything :body anything) => anything :times 1
+;;     (circle.backend.email/send :to "baz@bar.com" :subject anything :body anything) => anything :times 1))


Enforce hints on show

Enforce hints on show

--- test/obb_api/handlers/play_game_test.clj
+++ test/obb_api/handlers/play_game_test.clj
@@ -119,6 +119,7 @@
       (let [game-id (:_id game)
             [response status] (service/get-json "donbonifacio" (str "/game/" game-id))]
         (is (= status 200))
+        (is (< 0 (count (get-in response [:hints]))))
         (is (= "p1" (get-in response [:board :state])))
         (is (nil? (get-in response [:board :elements (keyword "[8 8]")])))))))


AB & RS | 7 | Add header logo theme.css kerodon test

--- test/stonecutter/integration/kerodon.clj
+++ test/stonecutter/integration/kerodon.clj
@@ -300,12 +300,17 @@
                 (k/visit "/register")) => (throws Exception)))

 (fact "theme.css file is generated using environment variables"
-      (-> (k/session (h/create-app {:secure "false" :header-bg-color "#012345" :inactive-tab-font-color "#FEDCBA"}
+      (-> (k/session (h/create-app {:secure "false"
+                                    :header-bg-color "#012345"
+                                    :inactive-tab-font-color "#FEDCBA"
+                                    :static-resources-dir-path "./test-resources"
+                                    :logo-file-name "beautiful_logo.png"}
                                    :dev-mode? false))
           (k/visit "/stylesheets/theme.css")
           (kh/response-status-is 200)
           (kh/response-body-contains "#012345")
-          (kh/response-body-contains "#fedcba")))
+          (kh/response-body-contains "#fedcba")
+          (kh/response-body-contains "\"beautiful_logo.png\"")))

 (fact "Correct css file is used when config includes a :theme"
       (-> (k/session (h/create-app {:secure "false" :theme "MY_STYLING"} :dev-mode? false))


Spec integrant a.l.component.handler

Spec integrant a.l.component.handler

--- backend/src/akvo/lumen/component/handler.clj
+++ backend/src/akvo/lumen/component/handler.clj
@@ -32,6 +32,18 @@
           handler (wrap-mw (apply compojure.core/routes routes))]
       (assoc component :handler handler))
     opts))
+
+(s/def ::endpoints (s/coll-of fn? :count 24 :distinct true))
+
+(s/def ::functions (s/map-of keyword? fn?))
+(s/def ::applied (s/coll-of keyword?  :distinct true))
+(s/def ::middleware (s/keys :req-un [::functions ::applied]))
+
+(defmethod integrant-key :akvo.lumen.component.handler/handler [_]
+  (s/cat :kw keyword?
+         :config (s/keys :req-un [::endpoints ::middleware] )))
+
+

 (defmethod ig/halt-key! :akvo.lumen.component.handler/handler  [_ opts]
   (dissoc opts :handler))


Beef up console API docs.

Beef up console API docs.

--- src/afterglow/web/routes/web_repl.clj
+++ src/afterglow/web/routes/web_repl.clj
@@ -6,9 +6,9 @@
             [ring.util.response :refer [response]]
             [taoensso.timbre :refer [info warn spy]]))

-(defonce repl-sessions (ref {}))
+(defonce ^:private repl-sessions (ref {}))

-(defn current-bindings []
+(defn- current-bindings []
   (binding [*ns* *ns*
             *warn-on-reflection* *warn-on-reflection*
             *math-context* *math-context*
@@ -24,7 +24,7 @@
             *e nil]
     (get-thread-bindings)))

-(defn bindings-for [session-key]
+(defn- bindings-for [session-key]
   (when-not (@repl-sessions session-key)
     (binding [*ns* *ns*]
       (in-ns 'afterglow.examples)
@@ -32,7 +32,7 @@
        (commute repl-sessions assoc session-key (current-bindings)))))
   (@repl-sessions session-key))

-(defn store-bindings-for [session-key]
+(defn- store-bindings-for [session-key]
   (dosync
     (commute repl-sessions assoc session-key (current-bindings))))

@@ -43,6 +43,8 @@
       r#)))

 (defn do-eval [txt session-key]
+  "Evaluate an expression sent to the web REPL and return the result
+  or an error description."
   (with-session session-key
     (let [form (binding [*read-eval* false] (read-string txt))]
       (with-open [writer (java.io.StringWriter.)]


Add TODO note

Add TODO note

--- src/braid/client/ui/views/quests.cljs
+++ src/braid/client/ui/views/quests.cljs
@@ -43,3 +43,4 @@
 ; show instructions when click show-me
 ; update descriptions
 ; update listeners
+; consider requiring multiple of certain actions (and have progress)


TODOs

TODOs

--- src/clj/algorithms_clj/derivative.clj
+++ src/clj/algorithms_clj/derivative.clj
@@ -56,10 +56,12 @@
     :else (derivate-expr (first expr) (rest expr) var)
     ))

+;; TODO: this is not a dispatch on symbol nor var, but on the content of the var
 (defmethod derivate-expr +
   [_ terms var]
   (make-sum (map #(derivative % var) terms)))

+;; TODO: this is not a dispatch on symbol nor var, but on the content of the var
 (defmethod derivate-expr *
   [_ terms var]
   (make-sum


Fixing problem when getting echo10 collection search results.

--- src/cmr/search/api/search_results.clj
+++ src/cmr/search/api/search_results.clj
@@ -71,10 +71,12 @@

 (defmethod reference+metadata->xml-element :collection
   [reference metadata]
-  (let [{:keys [concept-id]} reference]
+  (let [{:keys [concept-id revision-id]} reference]
     (format "<result concept-id=\"%s\" revision-id=\"%s\">%s</result>"
             concept-id
+            revision-id
             metadata)))
+
 (defn- references->format
   "Converts search result references into the desired format"
   [context references format]


Update quickref content

Update quickref content

--- src/clj/clojuredocs/pages/quickref/static.clj
+++ src/clj/clojuredocs/pages/quickref/static.clj
@@ -5,7 +5,8 @@
      :categories
      ({:title "Numbers",
        :groups
-       ({:syms (+ - * / quot rem mod inc dec max min with-precision),
+       ({:syms (+ - * / quot rem mod inc dec max min with-precision
+                  numerator denominator rand rand-int),
          :title "Arithmetic"}
         {:syms (= == not= < > <= >=), :title "Compare"}
         {:syms
@@ -14,6 +15,7 @@
            bit-xor
            bit-flip
            bit-not
+           bit-and-not
            bit-clear
            bit-set
            bit-shift-left
@@ -23,13 +25,42 @@
         {:syms
          (byte short int long float double bigint bigdec num rationalize),
          :title "Cast"}
-        {:syms (nil? identical? zero? pos? neg? even? odd?),
+        {:syms (identical?
+                zero?
+                pos?
+                neg?
+                even?
+                odd?
+                number?
+                ratio?
+                rational?
+                integer?
+                int?
+                pos-int?
+                nat-int?
+                decimal?
+                bigdec?
+                float?
+                double?),
          :title "Test"})}
+      {:title "Booleans"
+       :groups
+       ({:syms (nil? true? false?), :title "Test"}
+        {:syms (boolean), :title "Cast"})}
       {:title "Symbols / Keywords",
        :groups
        ({:syms (keyword symbol), :title "Create"}
         {:syms (name intern namespace), :title "Use"}
-        {:syms (keyword? symbol?), :title "Test"})}
+        {:syms (keyword?
+                symbol?
+                ident?
+                simple-keyword?
+                simple-symbol?
+                simple-ident?
+                qualified-keyword?
+                qualified-symbol?
+                qualified-ident?),
+         :title "Test"})}
       {:title "Strings / Characters",
        :groups
        ({:syms (str print-str println-str pr-str prn-str with-out-str),
@@ -51,12 +82,19 @@
              if
              if-not
            if-let
+           if-some
            when
            when-not
            when-let
            when-first
+           when-some
            cond
            condp
+           cond->
+           cond->>
+           some->
+           some->>
+           as->
            case
            do
            eval
@@ -103,6 +141,7 @@
            restart-agent
            shutdown-agents
            *agent*
+           agent-errors
            error-handler
            set-error-handler!
            error-mode
@@ -117,6 +156,7 @@
            future-cancelled?
            future?),
          :title "Futures"}
+        {:syms (volatile! vswap! vreset!), :title "Volatiles"}
         {:syms
          (bound-fn
            bound-fn*
@@ -151,12 +191,17 @@
            memfn
            comp
            complement
+           comparator
+           fnil
            partial
            juxt
-           memoize),
+           memoize
+           some-fn
+           every-pred),
          :title "Create"}
         {:syms (-> ->> apply), :title "Call"}
-        {:syms (fn? ifn?), :title "Test"})}
+        {:syms (fn? ifn?), :title "Test"}
+        {:syms (compare hash), :title "Misc"})}
       {:title "Multifunctions",
        :groups
        ({:syms (defmulti defmethod), :title "Create"}
@@ -258,14 +303,15 @@
            vals
            get
            get-in
+           update
            update-in
            select-keys
            merge
-           merge-with),
-         :title "Use (Sorted Maps)"}
+           merge-with
+           reduce-kv),
+         :title "Use"}
         {:syms (rseq subseq rsubseq),
-
-         :title "Use"})}
+         :title "Use (Sorted Collections)"})}
       {:title "Sets",
        :groups
        ({:syms (hash-set set sorted-set sorted-set-by), :title "Create"}
@@ -280,6 +326,7 @@
        ({:syms
          (seq
            sequence
+           eduction
            repeat
            replicate
            range
@@ -310,6 +357,7 @@
            nnext
            nth
            nthnext
+           nthrest
            rand-nth
            butlast
            take
@@ -318,10 +366,7 @@
            take-while
            drop
            drop-last
-           drop-while
-           keep
-
-           keep-indexed),
+           drop-while),
          :title "Use (General)"}
         {:syms
          (conj
@@ -334,18 +379,29 @@
            split-at
            split-with
            filter
+           filterv
            remove
            replace
-           shuffle),
+           shuffle
+           random-sample
+           flatten
+           sort
+           sort-by
+           reverse
+           dedupe),
          :title "Use ('Modification')"}
         {:syms
          (for
              doseq
            map
+           mapv
            map-indexed
+           keep
+           keep-indexed
            mapcat
            reduce
            reductions
+           transduce
            max-key
            min-key
            doall
@@ -354,36 +410,7 @@
       {:title "Transients",
        :groups
        ({:syms (transient persistent!), :title "Create"}
-        {:syms (conj! pop! assoc! dissoc! disj!), :title "Use (General)"}
-        {:syms
-         (conj
-           concat
-           distinct
-           group-by
-           partition
-           partition-all
-           partition-by
-           split-at
-           split-with
-           filter
-           remove
-           replace
-           shuffle),
-         :title "Use ('Modification')"}
-        {:syms
-         (for
-             doseq
-           map
-           map-indexed
-           mapcat
-
-           reduce
-           reductions
-           max-key
-           min-key
-           doall
-           dorun),
-         :title "Use (Iteration)"})})}
+        {:syms (conj! pop! assoc! dissoc! disj!), :title "Use (General)"})})}
     {:title "Code Structure",
      :categories
      ({:title "Variables",


improved sorting in habits list

improved sorting in habits list

--- src/cljs/iwaswhere_web/ui/entry/briefing.cljs
+++ src/cljs/iwaswhere_web/ui/entry/briefing.cljs
@@ -48,6 +48,16 @@
                {:style {:background-color (cc/item-color story)}}]
               [:strong.name story] (u/duration-string v)])])))))

+(defn by-prio-by-active-from
+  "Compare by prio first, then by active-from."
+  [x y]
+  (let [prio-x (get-in x [:habit :priority] :X)
+        prio-y (get-in y [:habit :priority] :X)
+        c (compare prio-x prio-y)
+        active-x (get-in x [:habit :active-from])
+        active-y (get-in y [:habit :active-from])]
+    (if (not= c 0) c (compare active-x active-y))))
+
 (defn waiting-habits-list
   [tab-group put-fn]
   (let [cfg (subscribe [:cfg])
@@ -60,7 +70,7 @@
           (let [entries-map @entries-map
                 entries (->> (:waiting-habits @results)
                              (map (fn [ts] (get entries-map ts)))
-                             (sort-by #(or (-> % :habit :priority) :X)))
+                             (sort by-prio-by-active-from ))
                 conf (merge @cfg @options)]
             (if (:show-pvt @cfg)
               entries


add simple reducers benchmark

add simple reducers benchmark

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -1,6 +1,7 @@
 (ns cljs.benchmark-runner
   (:refer-clojure :exclude [println])
-  (:require [cljs.reader :as reader]))
+  (:require [cljs.reader :as reader]
+            [clojure.core.reducers :as r]))

 (def println print)

@@ -292,6 +293,9 @@
 (simple-benchmark [a (Box. 0) xs (vec (range 512))] (doseq [x xs y xs] (set! a -val (+ (.-val a) x))) 4)
 (println)

+(println ";; reducers")
+(simple-benchmark [xs (into [] (range 1000000))] (r/reduce + (r/map inc (r/map inc (r/map inc xs)))) 1)
+
 (println "\n")


Load bundled non-core namespace source maps

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -24,8 +24,7 @@
    [planck.pprint.data]
    [planck.pprint.width-adjust]
    [planck.repl-resources :refer [repl-special-doc-map special-doc-map]]
-   [planck.themes :refer [get-theme]]
-   [tailrecursion.cljson :refer [cljson->clj]]))
+   [planck.themes :refer [get-theme]]))

 #_(s/fdef planck.repl$macros/dir
     :args (s/cat :sym symbol?))
@@ -921,17 +920,73 @@
                     (handle-error e true)))))))))
     nil))

-(defn- load-core-source-maps!
+(defn- load-bundled-source-maps!
   []
   (when-not (get (:source-maps @planck.repl/st) 'cljs.core)
-    (swap! st update-in [:source-maps] merge {'cljs.core
-                                              (sm/decode
-                                                (cljson->clj
-                                                  (first (js/PLANCK_LOAD "cljs/core.js.map"))))
-                                              'cljs.core$macros
-                                              (sm/decode
-                                                (cljson->clj
-                                                  (first (js/PLANCK_LOAD "cljs/core$macros.js.map"))))})))
+    (let [source-map-path (fn [ns-sym]
+                            (str (cljs.js/ns->relpath ns-sym) ".js.map"))
+          load-source-maps (fn [ns-sym]
+                             (cljs/load-source-map! st ns-sym (->> ns-sym
+                                                                   source-map-path
+                                                                   js/PLANCK_LOAD
+                                                                   first)))]
+      ;; Source maps for bundled macros namespaces other than cljs.core are loaded
+      ;; via their cached ".js.map.json" file.
+      (doseq [ns-sym '[cljs.core
+                       cljs.core$macros
+                       cljs.analyzer.api
+                       cljs.compiler
+                       cljs.env
+                       cljs.js
+                       cljs.pprint
+                       cljs.reader
+                       cljs.source-map
+                       cljs.source-map.base64
+                       cljs.source-map.base64-vlq
+                       cljs.spec
+                       cljs.spec.impl.gen
+                       cljs.spec.test
+                       cljs.stacktrace
+                       cljs.tagged-literals
+                       cljs.test
+                       cljs.tools.reader
+                       cljs.tools.reader.impl.commons
+                       cljs.tools.reader.impl.utils
+                       cljs.tools.reader.reader-types
+                       clojure.core.reducers
+                       clojure.core.rrb-vector
+                       clojure.core.rrb-vector.interop
+                       clojure.core.rrb-vector.nodes
+                       clojure.core.rrb-vector.protocols
+                       clojure.core.rbb-vector.rbbt
+                       clojure.core.rbb-vector.transients
+                       clojure.core.rrb-vector.trees
+                       clojure.data
+                       clojure.set
+                       clojure.string
+                       clojure.walk
+                       clojure.zip
+                       cognitect.transit
+                       fipp.clojure
+                       fipp.deque
+                       fipp.edn
+                       fipp.ednize
+                       fipp.visit
+                       lazy-map.core
+                       planck.core
+                       planck.from.io.aviso.ansi
+                       planck.http
+                       planck.io
+                       planck.js-deps
+                       planck.pprint.code
+                       planck.pprint.data
+                       planck.pprint.width-adjust
+                       planck.repl
+                       planck.repl-resources
+                       planck.shell
+                       planck.themes
+                       tailrecursion.cljson]]
+        (load-source-maps ns-sym)))))

 (defonce ^:dynamic ^:private *planck-integration-tests* false)

@@ -1098,7 +1153,7 @@
      (when-let [data (and print-ex-data? (ex-data error))]
        (print-value data {::as-code? false}))
      (when include-stacktrace?
-       (load-core-source-maps!)
+       (load-bundled-source-maps!)
        (let [canonical-stacktrace (st/parse-stacktrace
                                     {}
                                     (.-stack error)


fix mongo breakout w/ rows aggregation

fix mongo breakout w/ rows aggregation

--- src/metabase/driver/mongo/query_processor.clj
+++ src/metabase/driver/mongo/query_processor.clj
@@ -176,6 +176,7 @@
   ;; or are we missing something?
   ;; At any rate these seem to be the most common use cases, so we can add more here if and when they're needed.
   (match aggregation
+    ["rows"]         nil
     ["count"]        ["count" {$sum 1}]
     ["avg" field-id] ["avg" {$avg (field-id->$string field-id)}]
     ["sum" field-id] ["sum" {$sum (field-id->$string field-id)}]))
@@ -193,8 +194,9 @@
         $fields              (map field-id->$string field-ids)
         fields->$fields      (zipmap fields $fields)]
     (aggregate {$group  (merge {"_id"    (if (= (count fields) 1) (first $fields)
-                                             fields->$fields)
-                                ag-field ag-clause}
+                                             fields->$fields)}
+                               (when (and ag-field ag-clause)
+                                 {ag-field ag-clause})
                                (->> fields->$fields
                                     (map (fn [[field $field]]
                                            (when-not (= field "_id")
@@ -206,8 +208,9 @@
                                                                           "ascending" 1
                                                                           "descending" -1)]))
                               (apply sorted-map))}
-               {$project (merge {"_id"    false
-                                 ag-field true}
+               {$project (merge {"_id"    false}
+                                (when ag-field
+                                  {ag-field true})
                                 (zipmap fields (repeat true)))}
                (when limit
                  {$limit limit}))))


Refactored pager generation to be more readable.

--- src/lambda_blog/templates/entries.clj
+++ src/lambda_blog/templates/entries.clj
@@ -12,33 +12,38 @@
                  (:id %)))
             (sort-by :id tags))))

-(defn- pager [{:keys [path-to-root]} {:keys [path title] :as link} class]
-  (div {:class [:col-xs-2 :col-sm-3]}
-       (when link
-         (nav
-          (ul {:class :pager}
-              (li {:class class}
-                  (a {:href (pathcat path-to-root path)}
-                     (when (= class :previous)
-                       (i {:class [:fa :fa-chevron-left]}))
-                     (span {:class [:title-short :hidden-xs]}
-                           title)
-                     (when (= class :next)
-                       (i {:class [:fa :fa-chevron-right]})))))))))
+(defn- pager [class url & contents]
+  (nav (ul {:class :pager}
+           (li {:class class}
+               (apply a {:href url} contents)))))

 (defn entry
-  [{:keys [author contents next previous timestamp title] :as ent}]
+  [{:keys [author contents next path-to-root previous timestamp title] :as ent}]
   (article
    (header
     (panel
      (row
-      (pager ent previous :previous)
+      (div {:class [:col-xs-2 :col-sm-3]}
+           (when previous
+             (pager :previous
+                    (pathcat path-to-root (:path previous))
+                    (i {:class [:fa :fa-chevron-left]})
+                    " "
+                    (span {:class [:hidden-xs]}
+                          (:title previous)))))
       (div {:class [:col-xs-8 :col-sm-6]}
            (text-centered (h1 title)
                           (p "Posted on " (time (format-date timestamp))
                              " by " author)
                           (entry-tags ent)))
-      (pager ent next :next))))
+      (div {:class [:col-xs-2 :col-sm-3]}
+           (when next
+             (pager :next
+                    (pathcat path-to-root (:path next))
+                    (span {:class [:hidden-xs]}
+                          (:title next))
+                    " "
+                    (i {:class [:fa :fa-chevron-right]})))))))
    contents))

 (def entry-page (partial page entry))


bumped up cryogen-core to 0.4.0

bumped up cryogen-core to 0.4.0

--- src/leiningen/new/cryogen/project.clj
+++ src/leiningen/new/cryogen/project.clj
@@ -8,7 +8,7 @@
                            [compojure "1.6.2"]
                            [ring-server "0.5.0"]
                            [cryogen-flexmark "0.1.4"]
-                           [cryogen-core "0.3.2"]]
+                           [cryogen-core "0.4.0"]]
             :plugins [[lein-ring "0.12.5"]]
             :main cryogen.core
             :ring {:init cryogen.server/init


Restore support for --as-jars option that was accidentally removed

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -494,7 +494,13 @@
     (core/with-pre-wrap [fs]
       (when (seq jars)
         (util/info "Adding uberjar entries...\n"))
-      (core/commit! (reduce reducer fs jars)))))
+      (when as-jars
+        (doseq [jar jars]
+          (let [name (str (digest/md5 jar) "-" (.getName jar))]
+            (file/copy-with-lastmod jar (io/file tgt name)))))
+      (core/commit! (if as-jars
+                      (core/add-resource fs tgt)
+                      (reduce reducer fs jars))))))

 (core/deftask web
   "Create project web.xml file.


Fix occasionally failing test

Fix occasionally failing test

This test failed probabilistically about once every 10^4 runs;
increasing this parameter changes it to 10^40, which should be less of a
nuisance.

--- src/test/clojure/clojure/test/check/test.cljc
+++ src/test/clojure/clojure/test/check/test.cljc
@@ -439,7 +439,7 @@
        [[0 1 2] [0 2 1] [1 0 2] [1 2 0] [2 0 1] [2 1 0]]))))

 (defspec distinct-collections-with-few-possible-values 20
-  (prop/for-all [boolean-sets (gen/vector (gen/resize 5 (gen/set gen/boolean)) 100)]
+  (prop/for-all [boolean-sets (gen/vector (gen/resize 5 (gen/set gen/boolean)) 1000)]
     (= 4 (count (distinct boolean-sets)))))

 (deftest can't-generate-set-of-five-booleans


fix goog-define replacement not working in AOT

no clue why it doesn't work anymore since it worked in
previous releases ...

--- src/main/shadow/build/cljs_hacks.cljc
+++ src/main/shadow/build/cljs_hacks.cljc
@@ -650,6 +650,40 @@
     (log/debug ::replace-fn! {:the-var the-var})
     (alter-var-root the-var (fn [_] the-fn))))

+
+;; overriding for the closure-compiler, closure-library
+;; releases where goog.define must be assigned and will otherwise throw
+;; which makes this actually much easier to use
+(defn goog-define
+  "Defines a var using `goog.define`. Passed default value must be
+  string, number or boolean.
+
+  Default value can be overridden at compile time using the
+  compiler option `:closure-defines`.
+
+  Example:
+    (ns your-app.core)
+    (goog-define DEBUG! false)
+    ;; can be overridden with
+    :closure-defines {\"your_app.core.DEBUG_BANG_\" true}
+    or
+    :closure-defines {'your-app.core/DEBUG! true}"
+  [&form &env sym default]
+  (let [defname (comp/munge (str *ns* "/" sym))
+        type (cond
+               (string? default) "string"
+               (number? default) "number"
+               (or (true? default) (false? default)) "boolean")]
+
+    `(def ~(vary-meta sym
+             (fn [m]
+               (-> m
+                   (update :jsdoc conj (str "@define {" type "}"))
+                   (cond->
+                     (not (contains? m :tag))
+                     (assoc :tag (symbol type))))))
+       (js/goog.define ~defname ~default))))
+
 (defn install-hacks! []
   ;; cljs.analyzer tweaks
   (replace-fn! #'ana/load-core shadow-load-core)
@@ -660,6 +694,8 @@
   (replace-fn! #'comp/emitln shadow-emitln)

   (replace-fn! #'comp/find-ns-starts-with shadow-find-ns-starts-with)
+
+  (replace-fn! #'cljs.core/goog-define goog-define)

   ;; remove these for now, not worth the trouble
   ;; (replace-fn! #'test/deftest @#'shadow-deftest)
@@ -891,46 +927,6 @@
       (bool-expr (concat (core/list 'js* js) syms)))
     `(some? ~x)))

-
-;; overriding for the closure-compiler, closure-library
-;; releases where goog.define must be assigned and will otherwise throw
-;; which makes this actually much easier to use
-(core/defmacro goog-define
-  "Defines a var using `goog.define`. Passed default value must be
-  string, number or boolean.
-
-  Default value can be overridden at compile time using the
-  compiler option `:closure-defines`.
-
-  Example:
-    (ns your-app.core)
-    (goog-define DEBUG! false)
-    ;; can be overridden with
-    :closure-defines {\"your_app.core.DEBUG_BANG_\" true}
-    or
-    :closure-defines {'your-app.core/DEBUG! true}"
-  [sym default]
-  (assert-args goog-define
-    (core/or (core/string? default)
-             (core/number? default)
-             (core/true? default)
-             (core/false? default)) "a string, number or boolean as default value")
-  (core/let [defname (comp/munge (core/str *ns* "/" sym))
-             type (core/cond
-                    (core/string? default) "string"
-                    (core/number? default) "number"
-                    (core/or (core/true? default) (core/false? default)) "boolean")]
-
-    `(def ~(core/vary-meta sym
-             (core/fn [m]
-               (-> m
-                   (update :jsdoc conj (core/str "@define {" type "}"))
-                   (core/cond->
-                     (core/not (core/contains? m :tag))
-                     (core/assoc :tag (core/symbol type))))))
-       (js/goog.define ~defname ~default))))
-
-
 (core/defmacro defonce
   "defs name to have the root value of init iff the named var has no root value,
   else init is unevaluated"


marks test-trailers-support-h2c-proto-sediment as explicit (#700)

--- waiter/integration/waiter/basic_test.clj
+++ waiter/integration/waiter/basic_test.clj
@@ -467,7 +467,7 @@
   (testing-using-waiter-url
     (run-sediment-trailers-support-test waiter-url "http")))

-(deftest ^:parallel ^:integration-fast test-trailers-support-h2c-proto-sediment
+(deftest ^:parallel ^:integration-fast ^:explicit test-trailers-support-h2c-proto-sediment
   (testing-using-waiter-url
     (run-sediment-trailers-support-test waiter-url "h2c")))


add indent function

add indent function

--- saas-dsl/src/saas_dsl/parse.clj
+++ saas-dsl/src/saas_dsl/parse.clj
@@ -17,3 +17,9 @@
   "Does this line has an indent?"
   [loc]
   (pos? (count-space-indent (zip/node loc))))
+
+(defn drop-one-indent
+  "Shuffle this down an indent by stripping two leading spaces.")
+  [input-string]
+  (:pre [(and (= (.charAt input-string 0) \space) (= (.charAt input-string 1) \space))])
+  (subs input-string 2))


SearchResource.clj: started refactoring pagination

--- src/org/altlaw/www/SearchResource.clj
+++ src/org/altlaw/www/SearchResource.clj
@@ -26,46 +26,6 @@

 ;;; PAGE NUMBERING

-(def *page-size* 10)
-
-(def *window-size* 5)
-
-(defn page-ref [ref number]
-  (let [newref (Reference. ref)
-        query (.getQueryAsForm newref)]
-    (.set query "page" (str number) true)
-    (.setQuery newref (.encode query))
-    newref))
-
-(defn pagination-html [ref current total-hits]
-  (let [last-page (int (Math/ceil (/ total-hits (float *page-size*))))
-        window-start (if (< (- current *window-size*) 1)
-                       1 (- current *window-size*))
-        window-end (if (> (+ current *window-size*) last-page)
-                     last-page (+ current *window-size*))]
-    (with-out-str
-      (print "

")
-      (print "
Pages:
")
-      (if (= current 1)
-        (print "
« previous
")
-        (printf "
« previous
"
-                (str (page-ref ref (dec current)))))
-      (when (not= window-start 1)
-        (printf "
1
" (str (page-ref ref 1)))
-        (print "
...
"))
-      (doseq [n (range window-start (inc window-end))]
-        (if (= n current)
-          (printf "
%d
" n)
-          (printf "
%d
" (str (page-ref ref n)) n)))
-      (when (not= window-end last-page)
-        (print "
...
")
-        (printf "
%d
"
-                (str (page-ref ref last-page)) last-page))
-      (if (= current last-page)
-        (print "
next »
")
-        (printf "
next »
"
-                (str (page-ref ref (inc current)))))
-      (print "

"))))

 ;;; RENDERING RESULTS

@@ -99,6 +59,67 @@
      :hits (map (partial prepare-hit (.getHighlighting solr-response))
                 docs)}))

+(defn html-results [ref data]
+  (let [params (.. ref getQueryAsForm getValuesMap)
+        current-page (Integer/parseInt (or (get params "page") "1"))
+        pagination (when (> (:total_hits data) *page-size*)
+                     (pagination-html ref current-page (:total_hits data)))]
+    (tmpl/render "search/html_results"
+                 (assoc data :pagination pagination))))
+
+(defn order-for-display [sort]
+  (cond
+   (= sort "score desc") "relevance"
+   (= sort "date desc") "date"
+   :else "unknown order"))
+
+(defn make-sortlinks [ref sort]
+  (cond
+   (= sort "score desc") [{:url (sort-ref ref "date") :name "Sort by date"}]
+   (= sort "date desc") [{:url (sort-ref ref "relevance") :name "Sort by relevance"}]))
+
+(defmulti render-results (fn [this variant data] (.getMediaType variant)))
+
+(defmethod render-results MediaType/TEXT_HTML [this variant data]
+  (let [ref (.. this getRequest getOriginalRef)
+        ;; Do not display "relevance" sort link when using 'all' query
+        data (if (= (:query data) "docid:[* TO *]")
+               data
+               (assoc data
+                 :order (order-for-display (:sort data))
+                 :sortlinks (make-sortlinks ref (:sort data))))]
+    (StringRepresentation.
+     (html-results ref data)
+     MediaType/TEXT_HTML
+     Language/ENGLISH_US
+     CharacterSet/UTF_8)))
+
+
+;;; RENDERING EMPTY RESULT SET
+
+(defmulti render-no-results
+  (fn [this variant prepared] (.getMediaType variant)))
+
+(defmethod render-no-results MediaType/TEXT_HTML [this variant prepared]
+  (StringRepresentation.
+   (tmpl/render "search/html_no_results" prepared)
+   MediaType/TEXT_HTML
+   Language/ENGLISH_US
+   CharacterSet/UTF_8))
+
+
+;;; RENDERING BLANK FORMS
+
+(defn render-blank-form [this variant search-type]
+  (StringRepresentation.
+   (tmpl/render (str "search/" (name search-type) "_search_page"))
+   MediaType/TEXT_HTML
+   Language/ENGLISH_US
+   CharacterSet/UTF_8))
+
+
+;;; RENDERING EXCEPTIONS
+
 (defn html-exception [data]
   (tmpl/render "search/error_page"
                :error_message
@@ -109,83 +130,7 @@
                    (print "
"))
                  (.getMessage (stacktrace/root-cause (:exception data))))))

-(defn html-results [ref data]
-  (let [params (.. ref getQueryAsForm getValuesMap)
-        current-page (Integer/parseInt (or (get params "page") "1"))
-        pagination (when (> (:total_hits data) *page-size*)
-                     (pagination-html ref current-page (:total_hits data)))]
-    (tmpl/render "search/html_results"
-                 (assoc data :pagination pagination))))
-
-(defn html-no-results [data]
-  (tmpl/render "search/html_no_results" data))
-
-(defn order-for-display [sort]
-  (cond
-   (= sort "score desc") "relevance"
-   (= sort "date desc") "date"
-   :else "unknown order"))
-
-(defn sort-ref [ref sort]
-  (let [newref (Reference. ref)
-        query (.getQueryAsForm newref)]
-    (.set query "sort" sort true)
-    (.setQuery newref (.encode query))
-    newref))
-
-(defn make-sortlinks [ref sort]
-  (cond
-   (= sort "score desc") [{:url (sort-ref ref "date") :name "Sort by date"}]
-   (= sort "date desc") [{:url (sort-ref ref "relevance") :name "Sort by relevance"}]))
-
-(defmulti render-results (fn [this variant data] (.getMediaType variant)))
-
-(defmethod render-results MediaType/TEXT_HTML [this variant data]
-  (let [ref (.. this getRequest getOriginalRef)
-        data (if (= (:query data) "docid:[* TO *]")
-               data
-               (assoc data
-                 :order (order-for-display (:sort data))
-                 :sortlinks (make-sortlinks ref (:sort data))))]
-    (StringRepresentation.
-     (cond
-      (contains? data :exception) (html-exception data)
-      (zero? (:total_hits data)) (html-no-results data)
-      :else (html-results ref data))
-     MediaType/TEXT_HTML
-     Language/ENGLISH_US
-     CharacterSet/UTF_8)))
-
-
-(defn render-no-results [this variant prepared]
-  (StringRepresentation.
-   (html-no-results prepared)
-     MediaType/TEXT_HTML
-     Language/ENGLISH_US
-     CharacterSet/UTF_8))
-
-
-;;; RENDERING BLANK FORMS
-
-(defn html-form [query-type]
-  (tmpl/render (str "search/" (name query-type) "_search_page")))
-
-
-(defmulti render-blank-form (fn [this variant search-type] (.getMediaType variant)))
-
-(defmethod render-blank-form MediaType/TEXT_HTML [this variant search-type]
-  (StringRepresentation.
-   (html-form search-type)
-   MediaType/TEXT_HTML
-   Language/ENGLISH_US
-   CharacterSet/UTF_8))
-
-
-;;; RENDERING EXCEPTIONS
-
-(defmulti render-exception (fn [this variant data] (.getMediaType variant)))
-
-(defmethod render-exception MediaType/TEXT_HTML [this variant data]
+(defn render-exception MediaType/TEXT_HTML [this variant data]
   (StringRepresentation.
    (html-exception data)
    MediaType/TEXT_HTML
@@ -432,7 +377,7 @@
 (defn -isModifiable [this] false)

 (defn -getVariants [this]
-  [(Variant. MediaType/TEXT_HTML)])
+  [(Variant. MediaType/TEXT_HTML) (Variant. MediaType/APPLICATION_ATOM_XML)])

 (defn -represent [this variant]
   (try


re-align let binding-forms in #'mk-cgen-fn and #'mk-cgen

--- src/overtone/sc/machinery/defcgen.clj
+++ src/overtone/sc/machinery/defcgen.clj
@@ -88,17 +88,17 @@
   "Make the function which gets executed when a cgen is called."
   [params body]
   (let [expand-flags (map #(:expands? %) params)
-        param-names (vec (map :name params))
-        defaults    (reduce (fn [s el] (assoc s (:name el) (:default el)))
-                            {}
-                            params)
-        arg-sym     (gensym 'arg-sym)
-        sym-gensyms (syms->sym-gensym-pairs param-names)
-        bindings    (reduce (fn [final param]
-                              (conj final (get sym-gensyms (symbol (name param))) `(get (arg-mapper ~arg-sym ~param-names ~defaults) ~param)))
-                            []
-                            param-names)
-        body        (walk/prewalk-replace sym-gensyms body )]
+        param-names  (vec (map :name params))
+        defaults     (reduce (fn [s el] (assoc s (:name el) (:default el)))
+                             {}
+                             params)
+        arg-sym      (gensym 'arg-sym)
+        sym-gensyms  (syms->sym-gensym-pairs param-names)
+        bindings     (reduce (fn [final param]
+                               (conj final (get sym-gensyms (symbol (name param))) `(get (arg-mapper ~arg-sym ~param-names ~defaults) ~param)))
+                             []
+                             param-names)
+        body         (walk/prewalk-replace sym-gensyms body )]
     `(make-expanding
       (fn [& ~arg-sym]
         (let [~@bindings]
@@ -127,8 +127,8 @@
   params."
   ([c-name summary doc params body categories rate] (mk-cgen c-name summary doc params body categories rate #{rate}))
   ([c-name summary doc params body categories rate rates]
-     (let [full-doc    (generate-full-cgen-doc c-name summary doc categories rate params rates)
-           cgen-fn     (mk-cgen-fn params body)]
+     (let [full-doc (generate-full-cgen-doc c-name summary doc categories rate params rates)
+           cgen-fn  (mk-cgen-fn params body)]
        `(callable-map {:params ~params
                        :summary ~summary
                        :doc ~doc


Fix test names.

Fix test names.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -113,7 +113,7 @@
     (is (not (identical? input result)))
     (is (= expected result))))

-(deftest byte-array-to-csv-str-test
+(deftest incremental-byte-array-to-csv-str-test
   (let [expected "foo,bar,2048,4096"
         dsl-expression {:output-type :csv-str#inc
                         :rules [['udpSrc '(int16 50)]
@@ -123,7 +123,7 @@
         result (data-processing-fn byte-array-test-data input)]
     (is (= expected (str result)))))

-(deftest byte-array-to-json-str-test
+(deftest incremental-byte-array-to-json-str-test
   (let [expected "{\"foo\":\"bar\",\"udpSrc\":2048,\"udpDst\":4096}"
         dsl-expression {:output-type :json-str#inc
                         :rules [['udpSrc '(int16 50)]


Experimental doc string reflow

Experimental doc string reflow

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -67,6 +67,11 @@
     :name name-symbol
     :repl-special-function true))

+(defn reflow [text]
+  (-> text
+    (s/replace #" \n  " "")
+    (s/replace #"\n  " " ")))
+
 (defn ^:export read-eval-print [line]
   (binding [ana/*cljs-ns* @current-ns
             *ns* (create-ns @current-ns)
@@ -88,7 +93,7 @@
                                     (ensure
                                       (c/emit var-ast)))
                            var-ret (js/eval var-js)]
-                       (repl/print-doc (meta var-ret)))))
+                       (repl/print-doc (update (meta var-ret) :doc reflow)))))
               (let [_ (when DEBUG (prn "form:" form))
                     ast (ana/analyze env form)
                     _ (when DEBUG (prn "ast:" ast))


Rudimentary support for in-ns

Rudimentary support for in-ns

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -44,6 +44,9 @@
 (defn ns-form? [form]
   (and (seq? form) (= 'ns (first form))))

+(defn repl-special? [form]
+  (and (seq? form) (= 'in-ns (first form))))
+
 (defn ^:export read-eval-print [line]
   (ns cljs.user)
   (binding [ana/*cljs-ns* @current-ns
@@ -55,26 +58,29 @@
                                        :def-emits-var true)]
         (try
           (let [_ (when DEBUG (prn "line:" line))
-                form (r/read-string line)
-                _ (when DEBUG (prn "form:" form))
-                ast (ana/analyze env form)
-                _ (when DEBUG (prn "ast:" ast))
-                js (with-out-str
-                     (ensure
-                       (c/emit ast)))
-                _ (when DEBUG (prn "js:" js))]
-            (try (prn (let [ret (js/eval js)]
-                        (when-not
-                          (or ('#{*1 *2 *3 *e} form)
-                            (ns-form? form))
-                          (set! *3 *2)
-                          (set! *2 *1)
-                          (set! *1 ret))
-                        (when (ns-form? form)
-                          (reset! current-ns (second form)))
-                        ret))
-                 (catch js/Error e
-                   (set! *e e)
-                   (print (.-message e) "\n" (first (s/split (.-stack e) #"eval code"))))))
+                form (r/read-string line)]
+            (if (repl-special? form)
+              (case (first form)
+                'in-ns (reset! current-ns (second (second form))))
+              (let [_ (when DEBUG (prn "form:" form))
+                    ast (ana/analyze env form)
+                    _ (when DEBUG (prn "ast:" ast))
+                    js (with-out-str
+                         (ensure
+                           (c/emit ast)))
+                    _ (when DEBUG (prn "js:" js))]
+                (try (prn (let [ret (js/eval js)]
+                            (when-not
+                              (or ('#{*1 *2 *3 *e} form)
+                                (ns-form? form))
+                              (set! *3 *2)
+                              (set! *2 *1)
+                              (set! *1 ret))
+                            (when (ns-form? form)
+                              (reset! current-ns (second form)))
+                            ret))
+                     (catch js/Error e
+                       (set! *e e)
+                       (print (.-message e) "\n" (first (s/split (.-stack e) #"eval code"))))))))
           (catch js/Error e
             (println (.-message e))))))))


Dont send unprocessed images

Dont send unprocessed images

When selecting an image from camera roll we would immediately setting
the filepath with the raw image, process and later once it was processed
we would replace the file path.
On slow devices, the user might press send while the image is still
processing, causing the raw image to be sent, which might be discarded
as too large and never sent.

This commit changes the behavior so that we only set the uri once the
image is processed, it might add some delay, but the image should be
correctly sent.

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/chat/models/images.cljs
+++ src/status_im/chat/models/images.cljs
@@ -141,12 +141,11 @@
   (let [current-chat-id (:current-chat-id db)
         images          (get-in db [:chats current-chat-id :metadata :sending-image])]
     (if (get-in db [:chats current-chat-id :timeline?])
-      {:db              (update-in db [:chats current-chat-id :metadata :sending-image] {uri {:uri uri}})
+      {:db              (assoc-in db [:chats current-chat-id :metadata :sending-image] {})
        ::image-selected uri}
       (when (and (< (count images) config/max-images-batch)
                  (not (get images uri)))
-        {:db              (update-in db [:chats current-chat-id :metadata :sending-image] assoc uri {:uri uri})
-         ::image-selected uri}))))
+        {::image-selected uri}))))

 (fx/defn save-image-to-gallery
   {:events [:chat.ui/save-image-to-gallery]}


Add open/close-context with assertions

Add open/close-context with assertions

--- src/main/clojure/com/stuartsierra/lazytest/contexts.clj
+++ src/main/clojure/com/stuartsierra/lazytest/contexts.clj
@@ -45,7 +45,46 @@
     `(def ~name (with-meta (context ~bindings ~@decl)
                   (standard-metadata &form docstring name)))))

-(let [c (context [] 1)]
+
+(defn open-context
+  "Opens context c, and all its parents, unless it is already active."
+  [active c]
+  (let [active (reduce open-context active (:parents c))
+        states (map active (:parents c))]
+    (if-let [f (:before c)]
+      (assoc active c (or (active c) (apply f states)))
+      active)))
+
+(defn close-context
+  "Closes context c, and all its parents, and removes it from active."
+  [active c]
+  (let [states (map active (:parents c))]
+    (when-let [f (:after c)]
+      (apply f (active c) states))
+    (let [active (reduce close-context active (:parents c))]
+      (dissoc active c))))
+
+
+
+;;; Assertions
+
+(let [c (context [] (+ 1 1))]
   (assert (fn? (:before c)))
-  (assert (= 1 ((:before c))))
+  (assert (= 2 ((:before c))))
   (assert (nil? (:after c))))
+
+(let [c1 (context [] (+ 1 0)
+                 :after x
+                 (assert (= x 1)))]
+  (assert (fn? (:before c1)))
+  (assert (fn? (:after c1)))
+  (assert (= {c1 1} (open-context {} c1)))
+  (assert (= {} (close-context {c1 1} c1)))
+
+  (let [c2 (context [x c1] (+ x 1)
+                    :after y
+                    (assert (= y 2)))]
+    (assert (fn? (:before c2)))
+    (assert (fn? (:after c2)))
+    (assert (= {c1 1 c2 2} (open-context {} c2)))
+    (assert (= {} (close-context {c1 1 c2 2} c2)))))


bump version

bump version

--- labs/architecture-examples/om/project.clj
+++ labs/architecture-examples/om/project.clj
@@ -3,7 +3,7 @@
   :url "http://example.com/FIXME"

   :dependencies [[org.clojure/clojure "1.5.1"]
-                 [org.clojure/clojurescript "0.0-2125"]
+                 [org.clojure/clojurescript "0.0-2127"]
                  [org.clojure/core.async "0.1.267.0-0d7780-alpha"]
                  [secretary "0.4.0"]
                  [om "0.1.0-SNAPSHOT"]]


Updates.

Updates.

--- Clojure/blackjack/src/blackjack/core.clj
+++ Clojure/blackjack/src/blackjack/core.clj
@@ -1,95 +1,141 @@
 (ns blackjack.core
   (:gen-class))

-(defn third [coll] (second (next coll)))
+(declare greedy-player-strategy many-games cautious-player-strategy inactive-player-strategy)

 (defn new-deck []
   (for [suit (range 4)
         kind (range 1 14)]
-    (list suit kind)))
+    {:suit suit :kind kind}))

 (defn card-string [card]
   (let [suits ["Spades" "Clubs" "Diamonds" "Hearts"]]
-    (str (case (second card)
+    (str (case (:kind card)
            1 "Ace"
            11 "Jack"
            12 "Queen"
            13 "King"
-           (str (second card)))
-         " of " (nth suits (first card)))))
+           (str (:kind card)))
+         " of " (nth suits (:suit card)))))

 (defn new-game []
   (let [deck (shuffle (new-deck))]
-    (list (list (first deck) (second deck))
-          (list (third deck) (third (next deck)))
-          (-> deck next next next next))))
+    {:player-hand (list (first deck) (second deck))
+     :dealer-hand (list (nth deck 3) (nth deck 4))
+     :deck (-> deck next next next next)}))

 (defn card-value [card]
-  (cond (= 1 (second card)) 11
-        (<= 10 (second card)) 10
-        :else (second card)))
+  (cond (= 1 (:kind card)) 11
+        (<= 10 (:kind card)) 10
+        :else (:kind card)))

 (defn hand-total [hand]
   (let [sum (reduce + 0 (map card-value hand))
-        aces (count (filter #(= 1 (second %)) hand))]
+        aces (count (filter #(= 1 (:kind %)) hand))]
     (if (or (<= sum 22) (= 0 aces))
       sum
       (- sum (* 10 (min aces (int (Math/ceil (/ (- sum 21) 10)))))))))

-(defn hit [hand deck]
-  (list (conj hand (first deck)) (next deck)))
+(defn hit [game-state which-player]
+  (let [nextcard (first (:deck game-state))
+        deck (which-player game-state)
+        newdeck (cons nextcard deck)]
+    (assoc game-state
+      which-player newdeck
+      :deck (next (:deck game-state)))))

-(defn user-strategy [player dealer deck]
+(defn user-strategy [game-state]
   "Lets the user decide whether to hit"
-  (if (< (hand-total player) 21)
+  (if (< (hand-total (:player-hand game-state)) 21)
     (do (println "hit or stay?")
-      (let [input (read-line)]
-        (if (= "hit" input)
-          (let [new-player (hit player deck)] (list (first new-player) dealer (second new-player)))
-          (list player dealer deck))))
-    (list player dealer deck)))
+        (let [input (read-line)]
+          (if (= "hit" input)
+            (hit game-state :player-hand)
+            game-state)))
+    game-state))

-(defn dealer-strategy [player dealer deck]
+(defn dealer-strategy [game-state]
   "Dealer always hits if less than 17"
-  (if (< (hand-total dealer) 17)
-    (let [new-hand (hit dealer deck)] (list player (first new-hand) (second new-hand)))
-    (list player dealer deck)))
+  (if (< (hand-total (:dealer-hand game-state)) 17)
+    (hit game-state :dealer-hand)
+    game-state))

-(defn do-turn [player dealer deck strategy]
-  (strategy player dealer deck))
+(defn do-turn [game-state strategy]
+  (strategy game-state))

-(defn user-turn [hand dealer deck]0
-  (let [score (hand-total hand)]
+(defn user-turn [game-state]
+  (let [hand (:player-hand game-state)
+        score (hand-total hand)]
     (println "Player hand:" (clojure.string/join ", " (map card-string hand))
              ";" score "points")
     (if (< score 21)
-      (let [next-state (do-turn hand dealer deck user-strategy)]
-        (if (not= (count hand) (count (first next-state)))
-          (apply user-turn next-state)
+      (let [next-state (do-turn game-state user-strategy)]
+        (if (not= (count hand) (count (:player-hand next-state)))
+          (user-turn next-state)
           next-state))
-      (list hand dealer deck))))
+      game-state)))

-(defn dealer-turn [player dealer deck]
-  (let [score (hand-total dealer)]
-  (println "Dealer's hand:" (clojure.string/join ", " (map card-string dealer))
+(defn dealer-turn [game-state]
+  (let [hand (:dealer-hand game-state)
+        score (hand-total hand)]
+  (println "Dealer's hand:" (clojure.string/join ", " (map card-string hand))
            ";" score "points")
-  (let [next-state (do-turn player dealer deck dealer-strategy)]
-    (if (not= (count dealer) (count (second next-state)))
+  (let [next-state (do-turn game-state dealer-strategy)]
+    (if (and (<= (hand-total (:player-hand game-state)) 21)
+             (not= (count hand) (count (:dealer-hand next-state))))
       (do (println "Dealer hits")
-          (apply dealer-turn next-state))
+          (dealer-turn next-state))
       next-state))))

-(defn one-game [player dealer deck]
-  (println "Dealer is showing" (card-string (first dealer)))
-  (let [end-game (apply dealer-turn (user-turn player dealer deck))
-        dealer-score (hand-total (second end-game))
-        player-score (hand-total (first end-game))]
-    (println (if (and (<= player-score 21) (> player-score dealer-score))
-               "Player wins!"
-               (if (= player-score dealer-score)
-                 "Tie game!"
-                 "Dealer wins!")))))
+(defn one-game [game-state]
+  (println "Dealer is showing" (card-string (first (:dealer-hand game-state))))
+  (let [end-game (dealer-turn (user-turn game-state))
+        dealer-score (hand-total (:dealer-hand end-game))
+        player-score (hand-total (:player-hand end-game))]
+    (if (and (<= player-score 21) (or (> player-score dealer-score) (> dealer-score 21)))
+      1
+      (if (= player-score dealer-score)
+        0
+        -1))))

 (defn -main
   [& args]
-  (apply one-game (new-game)))
+  (let [winner (one-game (new-game))]
+    (println (case winner
+               1 "Player wins!"
+               -1 "Dealer wins!"
+               :else "Tie game")))
+  )
+  ;(let [totals (many-games 1000 0 0 0)]
+  ;  (println totals)))
+
+(defn many-games [n player-wins dealer-wins ties]
+  (let [winner (one-game (new-game))]
+    (if (= n 0)
+      {:player-wins player-wins :dealer-wins dealer-wins :ties ties}
+      (many-games
+        (- n 1)
+        (if (= winner 1) (+ player-wins 1) player-wins)
+        (if (= winner -1) (+ dealer-wins 1) dealer-wins)
+        (if (= winner 0) (+ ties 1) ties)))))
+
+(defn greedy-player-strategy [game-state]
+  "A greedy player always hits until they get 21 or bust"
+  (if (< (hand-total (:player-hand game-state)) 21)
+    (do (println "Player hits")
+        (hit game-state :player-hand))
+    (do (println "Player stays")
+        game-state)))
+
+(defn cautious-player-strategy [game-state]
+  "A cautious player will only hit when under 15"
+  (if (< (hand-total (:player-hand game-state)) 15)
+    (do (println "Player hits")
+        (hit game-state :player-hand))
+    (do (println "P-layer stays")
+        game-state)))
+
+(defn inactive-player-strategy [game-state]
+  "An inactive player never hits"
+  (do (println "Player stays")
+      game-state))


Alias clojure.reflect/reflect

Alias clojure.reflect/reflect

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -42,6 +42,7 @@
                        clojure.repl/find-doc
                        clojure.repl/pst
                        clojure.repl/source
+                       ^:lazy clojure.reflect/reflect
                        ^:lazy clojure.test/run-all-tests
                        ^:lazy clojure.test/run-tests
                        ^:lazy clojure.tools.namespace.repl/refresh


Simplify format-duration

Simplify format-duration

--- src-cljs/frontend/datetime.cljs
+++ src-cljs/frontend/datetime.cljs
@@ -165,16 +165,15 @@

 (defn format-duration [duration-ms {:keys [seconds minutes hours days months years]}]
   (let [ago (max (.floor js/Math (/ duration-ms 1000)) 0)
-        interval (cond (< ago minute){:divisor 1      :unit seconds }
-                       (< ago hour)  {:divisor minute :unit minutes }
-                       (< ago day)   {:divisor hour   :unit hours   }
-                       (< ago month) {:divisor day    :unit days    }
-                       (< ago year)  {:divisor month  :unit months  }
-                       :else         {:divisor year   :unit years   })]
-    (let [time-count (.round js/Math (/ ago (:divisor interval)))]
-      (str time-count " "  (:unit interval) (when-not (or (= 1 time-count)
-                                                          (= 1 (count (:unit interval))))
-                                              "s")))))
+        [divisor unit] (cond
+                         (< ago minute) [1 seconds]
+                         (< ago hour) [minute minutes]
+                         (< ago day) [hour hours]
+                         (< ago month) [day days]
+                         (< ago year) [month months]
+                         :else [year years])
+        time-count (.round js/Math (/ ago divisor))]
+    (str time-count " " unit (when-not (= 1 time-count) "s"))))

 (defn time-ago [duration-ms]
   (format-duration duration-ms full-time-units))


[search] Remove unused variable

[search] Remove unused variable

--- src/braid/search/core.cljc
+++ src/braid/search/core.cljc
@@ -122,7 +122,7 @@
           :on-load (fn [page]
                      (dispatch [::set-query! (page :query)])
                      (dispatch [:braid.search/search-history! (page :query) (page :group-id)]))
-          :on-exit (fn [page]
+          :on-exit (fn [_]
                      (dispatch [::clear-search!]))
           :styles >search-page}))


Fix email on copyright notice on cek ns.

--- src/buddy/sign/jwe/cek.clj
+++ src/buddy/sign/jwe/cek.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.be>
+;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.nz>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


for ranging pieces, moving over to common algorithm with move rules

--- src/chess_clojure/core.clj
+++ src/chess_clojure/core.clj
@@ -43,6 +43,7 @@
 ;;
 ;;

+(def debug false)
 (defn string->board[string]
   (assert (string? string))
   (let [lines (vec (reverse (clojure.string/split-lines string)))
@@ -174,13 +175,39 @@
         ]
     [x y]))
 (println locations-helper)
+
+
+;; From wikipedia:
+;; A FEN record contains six fields. The separator between fields is a space. The fields are:
+;; Piece placement (from white's perspective). Each rank is described, starting with rank 8 and ending with rank 1; within each rank, the contents of each square are described from file "a" through file "h". Following the Standard Algebraic Notation (SAN), each piece is identified by a single letter taken from the standard English names (pawn = "P", knight = "N", bishop = "B", rook = "R", queen = "Q" and king = "K").[1] White pieces are designated using upper-case letters ("PNBRQK") while black pieces use lowercase ("pnbrqk"). Empty squares are noted using digits 1 through 8 (the number of empty squares), and "/" separates ranks.
+;; Active color. "w" means White moves next, "b" means Black.
+;; Castling availability. If neither side can castle, this is "-". Otherwise, this has one or more letters: "K" (White can castle kingside), "Q" (White can castle queenside), "k" (Black can castle kingside), and/or "q" (Black can castle queenside).
+;; En passant target square in algebraic notation. If there's no en passant target square, this is "-". If a pawn has just made a two-square move, this is the position "behind" the pawn. This is recorded regardless of whether there is a pawn in position to make an en passant capture.[2]
+;; Halfmove clock: This is the number of halfmoves since the last capture or pawn advance. This is used to determine if a draw can be claimed under the fifty-move rule.
+;; Fullmove number: The number of the full move. It starts at 1, and is incremented after Black's move.
+;; Example:
+;; rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1
+;; w means white to move- "side to move"
+;; The KQkq indicates all 4 castles are elegible.
+(defn board->fen[board]
+
+  )
 (defn board->string[board]
   (assert is-board? board)
+  (str
   (reduce (fn[accum location]
             (str accum
                  (get board location " ")
-                 (if (= 7 (first location)) "\n")
-                 )) "" locations-helper))
+
+                 (if (= 7 (first location))
+                   "\n")
+                 (if (and (= 7 (first location))
+                          (not= 0 (second location)))
+                       (str (second location) " ")))
+            ) "8 " locations-helper)
+      "  abcdefgh"
+    ))
+(println (board->string starting-board))
 ;;; to print board 0 7, 1 7,     7,7 cr
 ;;;                0 6 .........7 6 cr
 ;;;                ...
@@ -193,7 +220,6 @@
         starting-board-string
         (board->string
         (string->board starting-board-string)))))
-
 (defn on-board?[loc] (not (off-board? loc)))

 (defn bishop-non-captures[board location]
@@ -213,79 +239,45 @@
                                     )
                         ))))))

-(defn bishop-captures[board location]
-  "return list of captures that the bishop at location can make"
-  (assert (is-bishop? board location))
-  (assert (is-board? board))
-  (assert (valid-location? location))
-  (let [color (get-color (get board location))
-        [x y] location
-        ]
-    (remove nil?
-            (for [op1  [+ -] op2 [+ -]]  ;; to generate 4 diagonals
-              (loop [locs (for [z (drop 1(range))]
-                            [(op1 x z) (op2 y z)])
-                     ]
-                (cond (off-board? (first locs))
-                      nil
-                      (occupied-by-enemy? board (first locs) color)
-                      [ location (first locs) ]
-                      (occupied? board (first locs))
-                      nil
-                      true
-                      (recur  (next locs))))))))
-
-(defn can-move-through?[board loc]
-  (and (on-board? loc) (not (occupied? board loc))))
-
-(defn rook-non-captures[board location]
-  (println (get board location))
-  (assert (is-rook? (get board location)))
-  (assert (is-board? board))
-  (assert (valid-location? location))
-  (let [[x y] location]
-    (into []  ;
-          (map (partial vector location)
-               (concat
-                 (take-while  (partial can-move-through? board)
-                             (for [z (drop 1(range))]  [(+ x z) y] ))
-                 (take-while  (partial can-move-through? board)
-                             (for [z (drop 1(range))]  [(- x z) y] ))
-                 (take-while  (partial can-move-through? board)
-                             (for [z (drop 1(range))]  [x (+ z y)] ))
-                 (take-while  (partial can-move-through? board)
-                             (for [z (drop 1(range))]  [x (- z y)] ))
-                 )))))
-;; (test-rook-moves)
-(defn test-rook-moves[]
-  (let [board (string->board (join "\n"
-                                   ["  "
-                                    " R"
-                                    "  "]))
-        ]
-    (println (rook-non-captures board [1 1])))
-  )
-
-;; (test-rook-captures)
-
-;; z will range from 1 to infinity
-
-(defn look-for-rook-capture[board location direction-fn]
-  ;; location is the location of the rook
-  ;; generate locations to test using a function applied to the range 1..infinity
+(defn rook-right[x y z] [ (+ x z) y ])
+
+(defn rook-left[x y z] [ (- x z) y ])
+
+(defn rook-up[x y z] [ x (+ y z)])
+
+(defn rook-down[x y z] [ x (- y z)])
+
+(defn bishop-ne[x y z] [ (+ x z) (+ y z) ])
+
+(defn bishop-nw[x y z] [ (- x z) (+ y z) ])
+
+(defn bishop-se[x y z] [ (+ x z) (- y z)])
+
+(defn bishop-sw[x y z] [ (- x z) (- y z)])
+
+(def bishop-rules [bishop-ne bishop-nw bishop-se bishop-sw])
+(def rook-rules [rook-right rook-left rook-up rook-down])
+
+
+(def is-ranging? #{"q" "Q" "b" "B" "r" "R"})
+
+(defn ranging-capture-in-direction[board location direction-fn]
+  ;; location is the location of the friendly piece in question
+  ;; direction-fn generate locations to test using a function applied to the range 1..infinity
   ;; Finished when
   ;; 1. off board - return nil
   ;; 2. friendly piece found return nil
   ;; 3. enemy piece is found - return the location of the enemy piece
   ;;
-  (when false
-    (println "entering look-for-rook-capture, direction-fn is" direction-fn))
+  (when debug
+    (println "entering ranging-capture-in-direction, direction-fn is" direction-fn))
   (let [[x y] location
         color (get-color (get board location))
         ]
-    ;;  (println x y)
-    ;; (println board)
-    ;;(println location)
+    (when debug
+      (println x y)
+     (println (board->string board))
+    (println location))
     (loop [locs-to-test (for [z (drop 1(range))]  ;; lazy seq of locations to test
                           (direction-fn x y z))
            ]
@@ -303,30 +295,140 @@
           (recur  (next locs-to-test))))
       )))

+(defn ranging-captures[board location rules]
+  {:pre  []
+   :post [(set? %)]
+   }
+  "return set of locations for captures that the rook or bishop at location can make"
+  (assert (is-ranging? (get board location)))
+  (assert (is-board? board))
+  (assert (valid-location? location))
+  (let [color (get-color (get board location))
+        [x y] location
+        ]
+    (set
+     (map (fn[loc-to-capture] (vector location loc-to-capture))
+          (remove nil?
+                 (map
+                   (partial ranging-capture-in-direction board location)
+                   rules
+                   ))))))
+
+(defn bishop-captures[board location]
+  (ranging-captures board location bishop-rules)
+)
+
+;; (test-rook-moves)
+
+;; (test-rook-captures)
+
+;; z will range from 1 to infinity
+
+
+(defn look-for-non-capture-in-direction[board location direction-fn]
+  ;; location is the location of the friendly piece in question
+  ;; direction-fn generate locations to test using a function applied to the range 1..infinity
+  ;; Finished when
+  ;; 1. off board
+  ;; 2. piece found
+  ;; Returns set of zero or more moves found
+  ;;
+  (when debug
+    (println "entering look-for-capture-in-direction, direction-fn is" direction-fn))
+  (let [[x y] location
+        color (get-color (get board location))
+        ]
+    (when debug
+      (println x y)
+     (println (board->string board))
+    (println location))
+    (loop [locs-to-test (for [z (drop 1(range))]  ;; lazy seq of locations to test
+                          (direction-fn x y z))
+           accum []
+           ]
+      (let [loc-to-test (first locs-to-test)]
+        (when false
+          (println "processing " loc-to-test))
+        (cond
+          (off-board? loc-to-test)
+          accum
+          (occupied? board loc-to-test)
+           accum
+          true  ;; location is empty
+          (recur  (next locs-to-test) (conj accum loc-to-test) )))
+      )))
+
 ;; (f a b) -> a

-(defn rook-right[x y z] [ (+ x z) y ])
-(defn rook-left[x y z] [ (- x z) y ])
-(defn rook-up[x y z] [ x (+ y z)])
-(defn rook-down[x y z] [ x (- y z)])
+;; Pieces with a long range
+
+
+(defn ranging-non-captures[board location rules]
+  {:pre  [(vector? rules)]
+   :post [(set? %)]
+   }
+  "return set of locations for moves that the piece can make according to the rules which is an array of functions"
+  (assert (is-ranging? (get board location)))
+  (assert (is-board? board))
+  (assert (valid-location? location))
+  (let [color (get-color (get board location))
+        [x y] location
+        ]
+    (set (remove nil?
+                 (map
+                   (partial ranging-capture-in-direction board location)
+                   rules
+                   )))))
+

 (defn rook-captures[board location]
   {:pre  []
    :post [(set? %)]
    }
-  "return set of locations for captures that the rook at location can make"
-  (assert (is-rook? (get board location)))
-  (assert (is-board? board))
-  (assert (valid-location? location))
-  (let [color (get-color (get board location))
-        [x y] location
-        ]
-    (set (remove nil?
-                 (map
-                   (partial look-for-rook-capture board location)
-                   [rook-right rook-left rook-up rook-down]
-                   )))))
+  (ranging-captures board location rook-rules))
+
+(defn rook-non-captures[board location]
+  {:pre  []
+   :post [(set? %)]
+   }
+  (ranging-non-captures board location rook-rules))
+
+
+; (test-bishop-captures)
+(defn test-bishop-captures[]
+  (let [board (string->board (join "\n"
+
+                                   ["       "
+                                    "     p"
+                                    "  p   "
+                                    "   B   b"
+                                    "  pnQ  "
+                                    "          "]))
+        ]
+    (when debug
+      (println (board->string board))
+      )
+    (is (=
+          #{[2 1] [5 4] [2 3]}
+          (bishop-captures board [3 2])))
+    ))
+;;(def debug false)
+(defn test-rook-non-captures[]
+  (let [board (string->board (join "\n"
+                                   ["   p    "
+                                    "  pR   b"
+                                    "  pQ    "
+                                    "        "]))
+        ]
+    (when debug
+     (println (board->string board))
+      )
+    (is (=
+          #{[2 2] [3 3] [7 2]}
+          (rook-non-captures board [3 2])))
+    ))
+(test-rook-non-captures)
 (defn test-rook-captures[]
   (let [board (string->board (join "\n"
                                    ["   p  "
@@ -444,18 +546,37 @@
   (assert is-color? color)
   (assert is-board? board)
   (let [ opponent-king-piece (if (= color :white) "k" "K")
-        _ (println "1")
+        debug false
         king-location (some #(if (= opponent-king-piece (second %))
                                (first %))
                             board)
-        _ (println "1")
-        ]
+        ]
+    (when debug
+      (println "in checkmated?")
+        (println (moves board color)))
     (some #(when (= (second %) king-location) true) (moves board color))

     ))

 ;;;;;;;;;;;;;; TESTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn test-rook-captures2[]
+  (is (=
+       #{[[1 0] [0 0]]}
+        (rook-captures (string->board (str "BR\n"
+                                           "kR")) [1 0])))
+  )
+;; (test-rook-captures2)
+(defn test-rook-moves[]
+  (let [board (string->board (join "\n"
+                                   ["  "
+                                    " R"
+                                    "  "]))
+        ]
+    (println (rook-non-captures board [1 1])))
+  )
 (defn test-checkmated[]
+  ;; white checkmates black
   (assert (not (checkmated? (string->board "BR\nkR") :white)))
   (assert (checkmated? (string->board "BR\n k") :white))
   )
@@ -465,9 +586,11 @@
     (map #(move->algebraic-notation board %)
          (moves starting-board :black))))
 (defn run-tests[]
+(test-rook-captures2)
   (test-rook-moves)
   (test-pawn-moves)
   (test-checkmated)
+  (test-bishop-captures)
   (test-rook-captures)
 (test-board->string)
   (test-starting-moves)


Schematized chess.cljs

Schematized chess.cljs

--- src/chessground/chess.cljs
+++ src/chessground/chess.cljs
@@ -1,7 +1,10 @@
 (ns chessground.chess
   "Immutable board data. Does not implement chess rules"
   (:require [chessground.common :refer [pp]]
-            [chessground.fen :as forsyth]))
+            [chessground.fen :as forsyth]
+            [chessground.schemas :refer [ChessPiece BoardState PiecesMap Square]]
+            [schema.core :as s :refer [Str Int]])
+  (:require-macros [schema.macros :as sm :refer [defschema]]))

 (comment
   ; Representation of a chess game:
@@ -14,33 +17,56 @@

 (def clear {:pieces {}})

-(defn make [fen]
+(sm/defn make :- PiecesMap
+  [fen :- Str]
   {:pieces (forsyth/parse (when (not= fen "start") fen))})

-(defn get-piece [chess key] (get-in chess [:pieces key]))
+(sm/defn get-piece :- ChessPiece
+  [chess :- PiecesMap
+   key :- Str]
+  (get-in chess [:pieces key]))

-(defn get-pieces [chess] (:pieces chess))
+(sm/defn get-pieces :- BoardState
+  [chess :- PiecesMap]
+  (:pieces chess))

-(defn remove-piece [chess key] (update-in chess [:pieces] dissoc key))
+(sm/defn remove-piece :- PiecesMap
+  [chess :- PiecesMap
+   key :- Str]
+  (update-in chess [:pieces] dissoc key))

-(defn put-piece [chess key piece] (assoc-in chess [:pieces key] piece))
+(sm/defn put-piece :- PiecesMap
+  [chess :- PiecesMap
+   key :- Square
+   piece :- ChessPiece]
+  (assoc-in chess [:pieces key] piece))

-(defn set-pieces [chess changes]
+(sm/defn set-pieces :- PiecesMap
+  [chess :- PiecesMap
+   changes :- [[Square ChessPiece]]]
   (update-in chess [:pieces]
-    (fn [pieces] (reduce (fn [ps [key p]]
-                           (if p (assoc ps key p) (dissoc ps key)))
-                   pieces changes))))
+    (fn [pieces]
+      (reduce (fn [ps [key p]]
+                (if p (assoc ps key p) (dissoc ps key)))
+        pieces changes))))

-(defn- count-pieces [chess] (count (:pieces chess)))
+(sm/defn count-pieces :- Int
+  [chess :- PiecesMap]
+  (count (:pieces chess)))

-(defn move-piece [chess orig dest]
+(sm/defn move-piece :- (s/maybe PiecesMap)
   "Return nil if orig and dest make no sense"
+  [chess :- PiecesMap
+   orig :- Square
+   dest :- Square]
   (when (not= orig dest)
     (when-let [piece (get-piece chess orig)]
       (-> chess
           (remove-piece orig)
           (put-piece dest piece)))))

-(defn owner-color [chess key]
+(sm/defn owner-color :- (s/enum "white" "black")
   "Returns the color of the piece on this square key, or nil"
+  [chess :- PiecesMap
+   key :- Square]
   (:color (get-piece chess key)))


s/nbar/nbar1/

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -553,7 +553,7 @@
 (def np-grammar
   (let [grammar
         (filter #(or (= (:rule %) "noun-phrase2")
-                     (= (:rule %) "nbar"))
+                     (= (:rule %) "nbar1"))
                 grammar)
         rules (map #(keyword (get-in % [:rule])) grammar)
         lexicon


added vivere, double auxiliary verb

added vivere, double auxiliary verb

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -2046,10 +2046,16 @@
                           :artifact true}}})

    "vivere"
-   {:synsem {:cat :verb
+   [{:synsem {:cat :verb
              :sem {:pred :live}}
     :italiano {:passato "vissuto"
-               :future-stem "vivr"}}
+               :future-stem "vivr"
+               :essere true}}
+    {:synsem {:cat :verb
+             :sem {:pred :live}}
+    :italiano {:passato "vissuto"
+               :future-stem "vivr"
+               :essere false}}]

    "voi"
    [{:synsem {:cat cat-of-pronoun


use English for :pred

use English for :pred

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -581,7 +581,7 @@
                     :spec {:def :none} ;; "a casa", not "a mia casa", etc
                     :place true
                     :animate false
-                    :pred :casa}
+                    :pred :house}
               :subcat '()}}
     ]


model.place: add in-memory vector for places (for now nummela and helsinki)

--- src/busa_server/model/place.clj
+++ src/busa_server/model/place.clj
@@ -7,3 +7,7 @@

 (defn new-place [id name]
   (s/validate Place (map->Place {:id id :name name})))
+
+(def nummela (new-place "p1447" "Nummela"))
+(def helsinki (new-place "p1001" "Helsinki"))
+(def places [nummela helsinki])


add test for Tori Hanzō

add test for Tori Hanzō

--- src/clj/test/cards-upgrades.clj
+++ src/clj/test/cards-upgrades.clj
@@ -445,6 +445,37 @@
       (is (= 2 (:click (get-runner))) "Runner was charged 1click")
       (is (= 1 (count (:scored (get-runner)))) "1 scored agenda"))))

+(deftest tori-hanzo
+  "Tori Hanzō - Pay to do 1 brain damage instead of net damage"
+  (do-game
+    (new-game (default-corp [(qty "Pup" 1) (qty "Tori Hanzō" 1)])
+              (default-runner [(qty "Sure Gamble" 3) (qty "Net Shield" 1)]))
+    (core/gain state :corp :credit 10)
+    (play-from-hand state :corp "Pup" "HQ")
+    (play-from-hand state :corp "Tori Hanzō" "HQ")
+    (take-credits state :corp)
+    (play-from-hand state :runner "Net Shield")
+    (run-on state "HQ")
+    (let [pup (get-ice state :hq 0)
+          tori (get-content state :hq 0)
+          nshld (get-in @state [:runner :rig :program 0])]
+      (core/rez state :corp pup)
+      (core/rez state :corp tori)
+      (card-ability state :corp pup 0)
+      (card-ability state :runner nshld 0)
+      (prompt-choice :runner "Done")
+      (is (empty? (:discard (get-runner))) "1 net damage prevented")
+      (card-ability state :corp pup 0)
+      (prompt-choice :runner "Done") ; decline to prevent
+      (is (= 1 (count (:discard (get-runner)))) "1 net damage; previous prevention stopped Tori ability")
+      (run-jack-out state)
+      (run-on state "HQ")
+      (card-ability state :corp pup 0)
+      (prompt-choice :runner "Done")
+      (prompt-choice :corp "Yes")
+      (is (= 2 (count (:discard (get-runner)))) "1 brain damage suffered")
+      (is (= 1 (:brain-damage (get-runner)))))))
+
 (deftest valley-grid-trash
   "Valley Grid - Reduce Runner max hand size and restore it even if trashed"
   (do-game


Add lesson day to lessons in `ModulesMap` global

Because the day of the lesson is a critical piece of information when
dealing with an in memory representation of the timetable.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/main.cljs
+++ src/cljs/cljs_nusmods/main.cljs
@@ -342,6 +342,8 @@
    Lessons contain the following keys and values:

        :venue        String of the lesson venue
+       :day          0-indexed Integer of the day, where 0 = Monday,
+                       1 = Tuesday, etc, until 4 = Friday
        :startTime    0-indexed Integer of the time, where 0 = 0800, 1 = 0830,
                        and so on.
        :endTime      0-indexed Integer, similar meaning as :startTime
@@ -353,14 +355,15 @@
                                 lessonArrayRepr)
                   lessonType  (lesson-array-repr/get-lesson-type-string
                                 lessonArrayRepr lessonTypesStringsArray)
+                  lessonDay   (lesson-array-repr/get-lesson-day lessonArrayRepr)
                   lessonVenue (lesson-array-repr/get-lesson-venue-string
                                 lessonArrayRepr venuesStringsArray)
                   startTime   (lesson-array-repr/get-lesson-start-time
                                 lessonArrayRepr)
                   endTime     (lesson-array-repr/get-lesson-end-time
                                 lessonArrayRepr)
-                  lessonRepr  {:venue lessonVenue, :startTime startTime,
-                               :endTime endTime}]
+                  lessonRepr  {:venue lessonVenue, :day lessonDay,
+                               :startTime startTime, :endTime endTime}]
               (update-in lessonsMap ["lessons" lessonType lessonLabel]
                          (fn [lessonsVec]
                            (if (empty? lessonsVec)


Wire up the comics list to fetch all comics

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -33,6 +33,7 @@
   (re-frame/register-handler
    :view-site
    (fn [db [_ site-id]]
+     (api/get-comics site-id {:on-success comic-list/set})
      (-> db
          (assoc :page-key :comic-list
                 :site-id site-id
@@ -56,7 +57,7 @@
   (setup!)
   (site-list/setup!)
   (comic-list/setup!)
-  (api/get-sites {:on-success #(re-frame/dispatch [:set-site-list %])})
+  (api/get-sites {:on-success site-list/set})
   (re-frame/dispatch [:initialize-app-state {:page-key :site-list
                                              :site-list :loading}])
   (reagent/render-component [main-panel-container]


Change image component to handle more than just tags

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -55,8 +55,8 @@
                     comic-list)])))))

 (defn img-component [site
-                     {:keys [comic chapter page]}
-                     img-tag]
+                     {:keys [comic]}
+                     {:keys [chapter page tag]}]
   (let [waypoint (clojure.core/atom nil)]
     (reagent/create-class
      {:component-did-mount
@@ -72,8 +72,8 @@
                                     :page page}))})]
           (reset! waypoint wp)))
       :reagent-render
-      (fn [img-tag]
-        img-tag)})))
+      (fn [site location {:keys [tag]}]
+        tag)})))

 (defn reader []
   (let [site       (rf/subscribe [:site])


Fix anim-score to not use an async timeout

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -88,9 +88,10 @@
                                     (let [old-val (:value (r/props this))
                                           new-val (:value (get new-props 1))]
                                       (when-not (= old-val new-val)
-                                        (r/set-state this {:updated? true})
-                                        (go (async/timeout 1)
-                                            (r/set-state this {:updated? false})))))
+                                        (r/set-state this {:updated? true}))))
+    :component-did-update (fn [this old-props old-children]
+                            (when (:updated? (r/state this))
+                              (r/set-state this {:updated? false})))
     :render (fn [this]
               [:span {:class (if (:updated? (r/state this))
                                "new"


Added typehints in close-under-implication

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -38,8 +38,10 @@
 (defmethod conclusion Implication [#^Implication impl]
   (.conclusion impl))

-(defmethod print-method Implication [impl out]
-  (.write out (str "(" (premise impl) "  ==>  " (conclusion impl) ")")))
+(defmethod print-method Implication
+  [impl out]
+  (.write ^java.io.Writer out
+          ^String (str "(" (premise impl) "  ==>  " (conclusion impl) ")")))

 ;;;

@@ -70,8 +72,8 @@
   ;; this is LinClosure
   (let [^HashMap counts (HashMap.),
         ^HashMap list   (HashMap.),
-        ^HashSet update (HashSet. start),
-        ^HashSet newdep (HashSet. start)]
+        ^HashSet update (HashSet. ^java.util.Collection start),
+        ^HashSet newdep (HashSet. ^java.util.Collection start)]
     (doseq [impl implications
             :let [impl-count (count (premise impl))]]
       (.put counts impl impl-count)
@@ -87,7 +89,7 @@
                 :let [impl-count (.get counts impl)]]
           (.put counts impl (dec impl-count))
           (when (zero? (dec impl-count))
-            (let [z (HashSet. (conclusion impl))]
+            (let [z (HashSet. ^java.util.Collection (conclusion impl))]
               (.removeAll z newdep)
               (.addAll newdep z)
               (.addAll update z))))))


Fixed case when `touch` breaked entity cache (closed #17)

--- src/datascript/impl/entity.cljs
+++ src/datascript/impl/entity.cljs
@@ -7,19 +7,26 @@
 (defn entity [db eid]
   (Entity. db eid false {}))

+(defn- entity-attr [db a datoms]
+  (if (dc/multival? db a)
+    (if (dc/ref? db a)
+      (reduce #(conj %1 (entity db (.-v %2))) #{} datoms)
+      (reduce #(conj %1 (.-v %2)) #{} datoms))
+    (if (dc/ref? db a)
+      (entity db (.-v (first datoms)))
+      (.-v (first datoms)))))
+
+(defn- datoms->cache [db datoms]
+  (reduce (fn [acc part]
+    (let [a (.-a (first part))]
+      (assoc acc a (entity-attr db a part))))
+    {} (partition-by :a datoms)))
+
 (defn touch [e]
   (when-not (.-touched e)
     (when-let [datoms (not-empty (dc/-search (.-db e) [(.-eid e)]))]
-      (let [db    (.-db e)
-            cache (reduce (fn [acc datom]
-                            (let [a (.-a datom)
-                                  v (.-v datom)]
-                              (if (dc/multival? db a)
-                                (assoc! acc a (conj (get acc a #{}) v))
-                                (assoc! acc a v))))
-                          (transient {}) datoms)]
-        (set! (.-touched e) true)
-        (set! (.-cache e) (persistent! cache)))))
+      (set! (.-touched e) true)
+      (set! (.-cache e) (datoms->cache (.-db e) datoms))))
   e)

 (defn- reverse-ref [attr]
@@ -113,12 +120,9 @@
             (if touched
               not-found
               (if-let [datoms (not-empty (dc/-search db [eid attr]))]
-                (let [wrap (if (dc/ref? db attr) #(entity db (.-v %)) #(.-v %))
-                      val  (if (dc/multival? db attr)
-                             (reduce #(conj %1 (wrap %2)) #{} datoms)
-                             (wrap (first datoms)))]
-                  (set! cache (assoc cache attr val))
-                  val)
+                (do
+                  (set! cache (assoc cache attr (entity-attr db attr datoms)))
+                  (cache attr))
                 not-found))))))

   IAssociative


destructuring

destructuring

--- src/desdemona/plugins/swift.clj
+++ src/desdemona/plugins/swift.clj
@@ -119,7 +119,7 @@
   that actually writes batches to Cloud Files."
   [pipeline-data]
   (let [task-map (:onyx.core/task-map pipeline-data)
-        auth-url (:swift/auth-url task-map)
-        username (:swift/username task-map)
-        api-key (:swift/api-key task-map)]
+        {auth-url :swift/auth-url
+         username :swift/username
+         api-key :swift/api-key} task-map]
     (->SwiftWriteRows auth-url username api-key)))


clean up webhook body

clean up webhook body

--- src/gh_waiting_room/service.clj
+++ src/gh_waiting_room/service.clj
@@ -42,22 +42,29 @@
       (throw (ex-info (format "Expected sha1 '%s' but received '%s'" expected actual)
                       {:expected expected :actual actual})))))

+(defn- json-payload->issue [body]
+  (let [json (json/read-str body)
+        full-name (get-in! json ["repository" "full_name"])
+        num (get-in! json ["issue" "number"])]
+    {:id (format "%s#%s" full-name num)
+     :number num
+     :action (get! json "action")}))
+
 (defn webhook-page
   [request]
   (let [body (slurp (:body request))]
     (when-let [secret (gh-hmac-secret)]
       (verify-secret! secret body (-> request :headers (get "x-hub-signature"))))

-    (let [params (json/read-str body)
-          action (get! params "action")
-          full-name (get-in! params ["repository" "full_name"])
-          issue-num (get-in! params ["issue" "number"])
-          issue-id (format "%s#%s" full-name issue-num)]
-      (when (some #{action} ["created" "reopened"])
-        (update-gh-issues)
-        (create-issue-comment @db issue-id issue-num))
-      (when (and (= action "closed") (some #(= (:id %) issue-id) (viewable-issues @db)))
-        (update-gh-issues))))
+    (let [issue (json-payload->issue body)]
+      (case (:action issue)
+        "created" (do (update-gh-issues)
+                      (create-issue-comment @db (:id issue) (:number issue)))
+        "reopened" (do (update-gh-issues)
+                       (create-issue-comment @db (:id issue) (:number issue)))
+        ;; for closed
+        (when (some #(= (:id %) (:id issue)) (viewable-issues @db))
+                   (update-gh-issues)))))
   {:status 200})

 (defon-response html-content-type


Now shows extra messages under the secret society missions panel

--- src/hphelper/frontend/play.cljs
+++ src/hphelper/frontend/play.cljs
@@ -220,27 +220,29 @@
             ]
            [:tbody
             ;; If admin, add buttons for changing. Will change values by the amount listed +-up to 3
-            (for [change [-20 -10 -5 0 +5 +10 +20]]
-              [:tr
-               (for [ind (->> @game-atom :indicies first keys (map name) sort)]
-                 [:td [:span {:class "btn btn-warning btn-xs"
-                                 :onClick #(ajax/GET (wrap-context "/api/admin/modify-index/")
-                                                     {:response-format (ajax/json-response-format {:keywords? true})
-                                                      :handler (fn [m]
-                                                                 (log/info "Modified index")
-                                                                 (get-updates)
-                                                                 )
-                                                      :params (merge @play-atom {:ind (name ind)
-                                                                                :amount (-> (rand-int 7) (+ -3) (+ change))
-                                                                                })
-                                                      }
-                                                     )
-                              }
-                       change
-                       ]
-                  ]
-                 )
-               ]
+            (if (= "admin" (:userlevel @play-atom))
+              (for [change [-20 -10 -5 0 +5 +10 +20]]
+                [:tr
+                 (for [ind (->> @game-atom :indicies first keys (map name) sort)]
+                   [:td [:span {:class "btn btn-warning btn-xs"
+                                :onClick #(ajax/GET (wrap-context "/api/admin/modify-index/")
+                                                    {:response-format (ajax/json-response-format {:keywords? true})
+                                                     :handler (fn [m]
+                                                                (log/info "Modified index")
+                                                                (get-updates)
+                                                                )
+                                                     :params (merge @play-atom {:ind (name ind)
+                                                                                :amount (-> (rand-int 7) (+ -3) (+ change))
+                                                                                })
+                                                     }
+                                                    )
+                                }
+                         change
+                         ]
+                    ]
+                   )
+                 ]
+                )
               )
             (->> @game-atom
                  :indicies
@@ -288,6 +290,10 @@
            [:tbody
             (doall (map display-single-society-mission
                         (sort-by :ss_name (:missions @game-atom))))
+            (doall (map (fn [i] [:tr [:td] [:td i]])
+                        (get-in @game-atom [:character :msgs])
+                        )
+                   )
             ]
            ]
           ]


Fix the prefer-method for drifts, as the interface changed

--- src/io/cyanite/engine/drift.clj
+++ src/io/cyanite/engine/drift.clj
@@ -43,4 +43,4 @@
   (deref [this]
     @slot))

-(prefer-method print-method clojure.lang.IPersistentMap clojure.lang.IDeref)
+(prefer-method print-method clojure.lang.IRecord clojure.lang.IDeref)


Refactor `compile-clojure` function

Refactor `compile-clojure` function

--- src/leiningen/droid/compile.clj
+++ src/leiningen/droid/compile.clj
@@ -3,6 +3,7 @@
   (:refer-clojure :exclude [compile])
   (:require [leiningen compile javac clean]
             [clojure.java.io :as io]
+            [clojure.set :as sets]
             [leiningen.core.eval :as eval])
   (:use [leiningen.droid.utils :only [get-sdk-android-jar
                                       ensure-paths sh dev-build?]]
@@ -11,6 +12,8 @@
          [main :only [debug info abort]]
          [classpath :only [get-classpath]]]
         [bultitude.core :only [namespaces-on-classpath]]))
+
+;; ### Pre-compilation tasks

 (defn code-gen
   "Generates the R.java file from the resources.
@@ -45,6 +48,33 @@
   [{:keys [compile-path]} & _]
   (leiningen.clean/delete-file-recursively compile-path :silently))

+;; ### Compilation
+
+;; Stores a set of namespaces that should always be compiled
+;; regardless of the build type. Since these namespaces are used in
+;; `eval-in-project` call they naturally don't get AOT-compiled during
+;; automatic dependency resolution, so we have to make sure they are
+;; compiled anyway.
+;;
+(def ^:private always-compile-ns
+  (set '(clojure.core clojure.core.protocols clojure.string
+                      clojure.java.io neko.init.options)))
+
+(defn namespaces-to-compile
+  "Takes project and returns a set of namespaces that should be AOT-compiled."
+  [{:keys [aot aot-exclude-ns] :as project}]
+  (-> (case aot
+        :all
+          (seq (leiningen.compile/stale-namespaces project))
+        :all-with-unused
+          (namespaces-on-classpath :classpath
+                                   (map io/file (get-classpath project)))
+        ;; else
+          (map symbol aot))
+      set
+      (sets/union always-compile-ns)
+      (sets/difference aot-exclude-ns)))
+
 (defn compile-clojure
   "Taken partly from Leiningen source code.

@@ -63,19 +93,12 @@
             manifest-path]} :android,
     :keys [aot aot-exclude-ns] :as project}]
   (info "Compiling Clojure files...")
+  (ensure-paths manifest-path)
   (debug "Project classpath:" (get-classpath project))
-  (let [nses
-        (case aot
-          :all
-            (conj (seq (leiningen.compile/stale-namespaces project))
-                  'neko.init.options)
-          :all-with-unused
-            (namespaces-on-classpath :classpath
-                                     (map io/file (get-classpath project)))
-          (conj (map symbol aot) 'neko.init.options))
-        nses (remove (set (map symbol aot-exclude-ns)) nses)
+  (let [nses (namespaces-to-compile project)
         dev-build (dev-build? project)
-        compiler-options (if dev-build {} {:elide-meta [:doc :file :line]})]
+        compiler-options (if dev-build {} {:elide-meta [:doc :file :line :added
+                                                        :arglists :private]})]
     (info (format "Build type: %s, dynamic compilation: %s, remote REPL: %s."
                   (if dev-build "debug" "release")
                   (if (or dev-build start-nrepl-server