update :warning and :closure-warning options schemas

fixes #571

--- sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
+++ sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
@@ -609,28 +609,41 @@
    :warnings-map-options
    (strict-keys
     :opt-un
-      [::undeclared-ns-form
-       ::protocol-deprecated
-       ::undeclared-protocol-symbol
-       ::fn-var
-       ::invalid-arithmetic
-       ::preamble-missing
-       ::undeclared-var
-       ::protocol-invalid-method
-       ::variadic-max-arity
-       ::multiple-variadic-overloads
-       ::fn-deprecated
-       ::redef
-       ::fn-arity
-       ::invalid-protocol-symbol
-       ::dynamic
-       ::undeclared-ns
-       ::overload-arity
-       ::extending-base-js-type
-       ::single-segment-namespace
-       ::protocol-duped-method
-       ::protocol-multiple-impls
-       ::invoke-ctor]))
+    [::dynamic
+     ::extending-base-js-type
+     ::extend-type-invalid-method-shape
+     ::fn-var
+     ::fn-arity
+     ::fn-deprecated
+     ::invalid-protocol-symbol
+     ::invoke-ctor
+     ::invalid-arithmetic
+     ::invalid-array-access
+     ::infer-warning
+     ::js-shadowed-by-local
+     ::multiple-variadic-overloads
+     ::munged-namespace
+     ::ns-var-clash
+     ::overload-arity
+     ::preamble-missing
+     ::protocol-deprecated
+     ::protocol-invalid-method
+     ::protocol-duped-method
+     ::protocol-multiple-impls
+     ::protocol-with-variadic-method
+     ::protocol-impl-with-variadic-method
+     ::protocol-impl-recur-with-target
+     ::redef
+     ::redef-in-file
+     ::single-segment-namespace
+     ::unprovided
+     ::undeclared-var
+     ::undeclared-ns
+     ::undeclared-ns-form
+     ::undeclared-protocol-symbol
+     ::unsupported-js-module-type
+     ::unsupported-preprocess-value
+     ::variadic-max-arity]))

   "This flag will turn on/off compiler warnings for references to
 undeclared vars, wrong function call arities, etc. Can be a boolean
@@ -646,6 +659,7 @@
 The following warnings are supported:

   :preamble-missing, missing preamble
+  :unprovided, required namespace not provided
   :undeclared-var, undeclared var
   :undeclared-ns, var references non-existent namespace
   :undeclared-ns-form, namespace reference in ns form that does not exist
@@ -666,31 +680,55 @@
   :protocol-invalid-method, protocol method does not match declaration
   :protocol-duped-method, duplicate protocol method implementation
   :protocol-multiple-impls, protocol implemented multiple times
-  :single-segment-namespace, single segment namespace")
+  :protocol-with-variadic-method, protocol declares variadic signature
+  :protocol-impl-with-variadic-method, protocol impl employs variadic signature
+  :protocol-impl-recur-with-target, target passed in recur to protocol method head
+  :single-segment-namespace, single segment namespace
+  :munged-namespace, namespace name contains a reserved JavaScript keyword
+  :ns-var-clash, namespace clashes with var
+  :extend-type-invalid-method-shape, method arities must be grouped together
+  :unsupported-js-module-type, unsupported JavaScript module type
+  :unsupported-preprocess-value, unsupported foreign lib preprocess value
+  :js-shadowed-by-local, name shadowed by a local
+  :infer-warning, warnings related to externs inference")

 ;; *** TODO differnet ns??
-(def-key ::undeclared-ns-form          boolean?)
-(def-key ::protocol-deprecated         boolean?)
-(def-key ::undeclared-protocol-symbol  boolean?)
-(def-key ::fn-var                      boolean?)
-(def-key ::invalid-arithmetic          boolean?)
-(def-key ::preamble-missing            boolean?)
-(def-key ::undeclared-var              boolean?)
-(def-key ::protocol-invalid-method     boolean?)
-(def-key ::variadic-max-arity          boolean?)
+
+(def-key ::dynamic boolean?)
+(def-key ::extending-base-js-type boolean?)
+(def-key ::extend-type-invalid-method-shape boolean?)
+(def-key ::fn-var boolean?)
+(def-key ::fn-arity boolean?)
+(def-key ::fn-deprecated boolean?)
+(def-key ::invalid-protocol-symbol boolean?)
+(def-key ::invoke-ctor boolean?)
+(def-key ::invalid-arithmetic boolean?)
+(def-key ::invalid-array-access boolean?)
+(def-key ::infer-warning boolean?)
+(def-key ::js-shadowed-by-local boolean?)
 (def-key ::multiple-variadic-overloads boolean?)
-(def-key ::fn-deprecated               boolean?)
-(def-key ::redef                       boolean?)
-(def-key ::fn-arity                    boolean?)
-(def-key ::invalid-protocol-symbol     boolean?)
-(def-key ::dynamic                     boolean?)
-(def-key ::undeclared-ns               boolean?)
-(def-key ::overload-arity              boolean?)
-(def-key ::extending-base-js-type      boolean?)
-(def-key ::single-segment-namespace    boolean?)
-(def-key ::protocol-duped-method       boolean?)
-(def-key ::protocol-multiple-impls     boolean?)
-(def-key ::invoke-ctor                 boolean?)
+(def-key ::munged-namespace boolean?)
+(def-key ::ns-var-clash boolean?)
+(def-key ::overload-arity boolean?)
+(def-key ::preamble-missing boolean?)
+(def-key ::protocol-deprecated boolean?)
+(def-key ::protocol-invalid-method boolean?)
+(def-key ::protocol-duped-method boolean?)
+(def-key ::protocol-multiple-impls boolean?)
+(def-key ::protocol-with-variadic-method boolean?)
+(def-key ::protocol-impl-with-variadic-method boolean?)
+(def-key ::protocol-impl-recur-with-target boolean?)
+(def-key ::redef boolean?)
+(def-key ::redef-in-file boolean?)
+(def-key ::single-segment-namespace boolean?)
+(def-key ::unprovided boolean?)
+(def-key ::undeclared-var boolean?)
+(def-key ::undeclared-ns boolean?)
+(def-key ::undeclared-ns-form boolean?)
+(def-key ::undeclared-protocol-symbol boolean?)
+(def-key ::unsupported-js-module-type boolean?)
+(def-key ::unsupported-preprocess-value boolean?)
+(def-key ::variadic-max-arity boolean?)

 ;; ** Closure Compiler Warnings

@@ -699,28 +737,60 @@
    :opt-un
    [::access-controls
     ::ambiguous-function-decl
-    ::debugger-statement-present
+    ::analyzer-checks
+    ::check-eventful-object-disposal
     ::check-regexp
     ::check-types
     ::check-useless-code
     ::check-variables
+    ::closure-dep-method-usage-checks
+    ::common-js-module-load
+    ::conformance-violations
     ::const
     ::constant-property
+    ::debugger-statement-present
     ::deprecated
+    ::deprecated-annotations
     ::duplicate-message
+    ::duplicate-vars
+    ::es3
     ::es5-strict
     ::externs-validation
+    ::extra-require
     ::fileoverview-jsdoc
+    ::function-params
     ::global-this
+    ::inferred-const-checks
     ::internet-explorer-checks
     ::invalid-casts
+    ::j2cl-checks
+    ::late-provide
+    ::lint-checks
+    ::message-descriptions
+    ::misplaced-type-annotation
+    ::missing-getcssname
+    ::missing-override
+    ::missing-polyfill
     ::missing-properties
+    ::missing-provide
+    ::missing-require
+    ::missing-return
     ::non-standard-jsdoc
+    ::report-unknown-types
+    ::strict-missing-require
     ::strict-module-dep-check
+    ::strict-requires
+    ::suspicious-code
     ::tweaks
+    ::type-invalidation
     ::undefined-names
     ::undefined-variables
+    ::underscore
     ::unknown-defines
+    ::unused-local-variable
+    ::unused-private-property
+    ::use-of-goog-base
+    ::violated-module-dep
     ::visiblity])

   "Configure warnings generated by the Closure compiler. A map from
@@ -733,28 +803,60 @@

   :access-controls
   :ambiguous-function-decl
-  :debugger-statement-present
+  :analyzer-checks
+  :check-eventful-object-disposal
   :check-regexp
   :check-types
   :check-useless-code
   :check-variables
+  :closure-dep-method-usage-checks
+  :common-js-module-load
+  :conformance-violations
   :const
   :constant-property
+  :debugger-statement-present
   :deprecated
+  :deprecated-annotations
   :duplicate-message
+  :duplicate-vars
+  :es3
   :es5-strict
   :externs-validation
+  :extra-require
   :fileoverview-jsdoc
+  :function-params
   :global-this
+  :inferred-const-checks
   :internet-explorer-checks
   :invalid-casts
+  :j2cl-checks
+  :late-provide
+  :lint-checks
+  :message-descriptions
+  :misplaced-type-annotation
+  :missing-getcssname
+  :missing-override
+  :missing-polyfill
   :missing-properties
+  :missing-provide
+  :missing-require
+  :missing-return
   :non-standard-jsdoc
+  :report-unknown-types
+  :strict-missing-require
   :strict-module-dep-check
+  :strict-requires
+  :suspicious-code
   :tweaks
+  :type-invalidation
   :undefined-names
   :undefined-variables
+  :underscore
   :unknown-defines
+  :unused-local-variable
+  :unused-private-property
+  :use-of-goog-base
+  :violated-module-dep
   :visiblity

 See the Closure Compiler Warning wiki for detailed descriptions.")
@@ -762,32 +864,63 @@
 (def-key ::warning-value #{:error :warning :off})

 ;; *** TODO differnet ns??
-(def-key ::access-controls            ::warning-value)
-(def-key ::ambiguous-function-decl    ::warning-value)
-(def-key ::debugger-statement-present ::warning-value)
-(def-key ::check-regexp               ::warning-value)
-(def-key ::check-types                ::warning-value)
-(def-key ::check-useless-code         ::warning-value)
-(def-key ::check-variables            ::warning-value)
-(def-key ::const                      ::warning-value)
-(def-key ::constant-property          ::warning-value)
-(def-key ::deprecated                 ::warning-value)
-(def-key ::duplicate-message          ::warning-value)
-(def-key ::es5-strict                 ::warning-value)
-(def-key ::externs-validation         ::warning-value)
-(def-key ::fileoverview-jsdoc         ::warning-value)
-(def-key ::global-this                ::warning-value)
-(def-key ::internet-explorer-checks   ::warning-value)
-(def-key ::invalid-casts              ::warning-value)
-(def-key ::missing-properties         ::warning-value)
-(def-key ::non-standard-jsdoc         ::warning-value)
-(def-key ::strict-module-dep-check    ::warning-value)
-(def-key ::tweaks                     ::warning-value)
-(def-key ::undefined-names            ::warning-value)
-(def-key ::undefined-variables        ::warning-value)
-(def-key ::unknown-defines            ::warning-value)
-(def-key ::visiblity                  ::warning-value)
-
+(def-key  ::access-controls ::warning-value)
+(def-key  ::ambiguous-function-decl ::warning-value)
+(def-key  ::analyzer-checks ::warning-value)
+(def-key  ::check-eventful-object-disposal ::warning-value)
+(def-key  ::check-regexp ::warning-value)
+(def-key  ::check-types ::warning-value)
+(def-key  ::check-useless-code ::warning-value)
+(def-key  ::check-variables ::warning-value)
+(def-key  ::closure-dep-method-usage-checks ::warning-value)
+(def-key  ::common-js-module-load ::warning-value)
+(def-key  ::conformance-violations ::warning-value)
+(def-key  ::const ::warning-value)
+(def-key  ::constant-property ::warning-value)
+(def-key  ::debugger-statement-present ::warning-value)
+(def-key  ::deprecated ::warning-value)
+(def-key  ::deprecated-annotations ::warning-value)
+(def-key  ::duplicate-message ::warning-value)
+(def-key  ::duplicate-vars ::warning-value)
+(def-key  ::es3 ::warning-value)
+(def-key  ::es5-strict ::warning-value)
+(def-key  ::externs-validation ::warning-value)
+(def-key  ::extra-require ::warning-value)
+(def-key  ::fileoverview-jsdoc ::warning-value)
+(def-key  ::function-params ::warning-value)
+(def-key  ::global-this ::warning-value)
+(def-key  ::inferred-const-checks ::warning-value)
+(def-key  ::internet-explorer-checks ::warning-value)
+(def-key  ::invalid-casts ::warning-value)
+(def-key  ::j2cl-checks ::warning-value)
+(def-key  ::late-provide ::warning-value)
+(def-key  ::lint-checks ::warning-value)
+(def-key  ::message-descriptions ::warning-value)
+(def-key  ::misplaced-type-annotation ::warning-value)
+(def-key  ::missing-getcssname ::warning-value)
+(def-key  ::missing-override ::warning-value)
+(def-key  ::missing-polyfill ::warning-value)
+(def-key  ::missing-properties ::warning-value)
+(def-key  ::missing-provide ::warning-value)
+(def-key  ::missing-require ::warning-value)
+(def-key  ::missing-return ::warning-value)
+(def-key  ::non-standard-jsdoc ::warning-value)
+(def-key  ::report-unknown-types ::warning-value)
+(def-key  ::strict-missing-require ::warning-value)
+(def-key  ::strict-module-dep-check ::warning-value)
+(def-key  ::strict-requires ::warning-value)
+(def-key  ::suspicious-code ::warning-value)
+(def-key  ::tweaks ::warning-value)
+(def-key  ::type-invalidation ::warning-value)
+(def-key  ::undefined-names ::warning-value)
+(def-key  ::undefined-variables ::warning-value)
+(def-key  ::underscore ::warning-value)
+(def-key  ::unknown-defines ::warning-value)
+(def-key  ::unused-local-variable ::warning-value)
+(def-key  ::unused-private-property ::warning-value)
+(def-key  ::use-of-goog-base ::warning-value)
+(def-key  ::violated-module-dep ::warning-value)
+(def-key  ::visiblity ::warning-value)

 ;; opt none helper
 (defn- opt-none? [opt]
@@ -905,7 +1038,4 @@
      ::watch-fn
      ::warnings
      ::fn-invoke-direct
-     ::rewrite-polyfills])
-
-
-   ))
+     ::rewrite-polyfills])))


♻ Deduplicate permission ID check

♻ Deduplicate permission ID check


Add tests around `cond-expr` for put-item

- Relates #106

--- test/taoensso/faraday/tests/main.clj
+++ test/taoensso/faraday/tests/main.clj
@@ -1294,3 +1294,38 @@
                    (proxy-super listStreams list-streams-request)))]
     (doall (far/list-streams (assoc *client-opts* :client client) {:table-name ttable}))
     (is (= 1 @calls))))
+
+(deftest attribute-not-exists
+  ;;https://github.com/Taoensso/faraday/issues/106
+
+  (far/put-item *client-opts* range-table {:title "Three" :number 33})
+
+  (is (thrown?
+       ConditionalCheckFailedException
+       (far/put-item *client-opts* range-table {:title "Three" :number 33}
+                     {:cond-expr "attribute_not_exists(#t) AND attribute_not_exists(#n)"
+                      ;; note typo in the issue. 'name' should be 'number'
+                      :expr-attr-names {"#n" "name"
+                                        "#t" "title"}})))
+
+  (is (thrown?
+       ConditionalCheckFailedException
+       (far/put-item *client-opts* range-table {:title "Three" :number 33}
+                     {:cond-expr "attribute_not_exists(#t) AND attribute_not_exists(#n)"
+                      ;; note typo in the issue: fixed here
+                      :expr-attr-names {"#n" "number"
+                                        "#t" "title"}})))
+
+  (is (thrown? ConditionalCheckFailedException
+               (far/put-item *client-opts* range-table {:title "Three" :number 33}
+                             {:cond-expr "attribute_not_exists(#t)"
+                              :expr-attr-names {"#t" "title"}})))
+
+  (is (thrown? ConditionalCheckFailedException
+               (far/put-item *client-opts* range-table {:title "Three" :number 33}
+                             {:cond-expr "attribute_not_exists(#n)"
+                              :expr-attr-names {"#n" "number"}})))
+
+  (far/put-item *client-opts* range-table {:title "Three" :number 35}
+                {:cond-expr "attribute_not_exists(#t)"
+                 :expr-attr-names {"#t" "title"}}))


a pet's owner must be human

a pet's owner must be human

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -93,7 +93,8 @@
    {:pet true} {:animate true
                 :buyable true
                 :edible false
-                :human false}
+                :human false
+                :spec {:of {:human true}}}

    {:physical-object false} {:animate false}


+{:pred :table}

+{:pred :table}

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -82,6 +82,7 @@
                       :legible false
                       :edible false
                       :place false
+                      :physical-object true
                       :speakable false}

    {:human true}     {:animate true
@@ -196,6 +197,9 @@
    ;; .. the next rule which applies to nouns only.
    {:pred :study
     :cat :noun}  {:place true}
+
+
+   {:pred :table} {:furniture true}

    {:pred :vino}     {:artifact true
                       :drinkable true}


Added args action block

Added args action block

--- src/blocks_editor/init.cljs
+++ src/blocks_editor/init.cljs
@@ -35,11 +35,15 @@
 (def action-block
   {:type "game_action"
    :lastDummyAlign0 "RIGHT"
-   :message0 "%1 %2"
+   :message0 "%1 %2 %3 %4"
    :args0 ["action"
-           {:type "field_input", :name "ACTION_NAME", :text "walk", :spellcheck false}]
+           {:type "field_input", :name "ACTION_NAME", :text "action_name", :spellcheck false}
+           "args"
+           {:type "input_value"
+            :name "ARGS"
+            :check "Array"}]
    :output "ActionBlock"
-   :colour 250
+   :colour 0
    :tooltip "Something to do and its args"
    :helpUrl ""})

@@ -50,7 +54,7 @@
 ;;            asdf#  (.require goog "Blockly.Blocks")
 ;;            bblocks# (js* "Blockly.Blocks")
 ;;            bsvg# (js* "Blockly.BlockSvg")]
-;;        ~(map (fn [[s m]] `(set! (~(symbol (str ".-" s))
+;;        ~@~(map (fn [[s m]] `(set! (~(symbol (str ".-" s))
 ;;                                 bblocks#)
 ;;                                (clj->js ~m)))
 ;;              ~bs))))


That really shouldn't have been annotated bytes

--- src/caesium/crypto/sign.clj
+++ src/caesium/crypto/sign.clj
@@ -48,7 +48,7 @@
 (defn sign
   "Produces a detached signature for a message m using given secret key."
   [sk m]
-  (let [sig (byte-array ^bytes bytes)]
+  (let [sig (byte-array bytes)]
     (sign-to-buf! sig sk m)))

 (defn verify


Fix docstring

Fix docstring

--- src/caesium/crypto/sign.clj
+++ src/caesium/crypto/sign.clj
@@ -6,7 +6,9 @@
 (defconsts [bytes seedbytes publickeybytes secretkeybytes primitive])

 (defn generate-signing-keys
-  "Generate a public-key and secret-key for signing with `crypto_sign_ed25519_seed_keypair`. If a seed is not provided, one is taken from `randombytes`.
+  "Generate a public-key and secret-key for signing with
+  `crypto_sign_ed25519_seed_keypair`. If a seed is not provided, one
+  is taken from `randombytes`.

   A map of the secret seed and public-key is returned."
   ([]


check url availability

check url availability

--- src/clj/ceres/collector.clj
+++ src/clj/ceres/collector.clj
@@ -81,8 +81,9 @@
 (defn store-article
   "Fetch html document, extract title and store them"
   [{:keys [url content-type ts] :as expanded-url}]
-  (let [raw-html (slurp url)
-        html-title (-> (java.io.StringReader. raw-html) enlive/html-resource (enlive/select [:head :title]) first :content first)]
+  (let [raw-html (if (= url "Not available") nil (slurp url))
+        html-title (if raw-html (-> (java.io.StringReader. raw-html) enlive/html-resource (enlive/select [:head :title]) first :content first)
+                       nil)]
     (mc/insert-and-return
      @db
      "articles"


remove traces of body-container

remove traces of body-container

--- src/clj/easynxc/handler.clj
+++ src/clj/easynxc/handler.clj
@@ -30,7 +30,7 @@
 (def loading-page
   (html5
    (head)
-   [:body {:class "body-container"}
+   [:body
     [:div#app]
     (include-js "/js/app.js")]))


update draw functions

update draw functions

--- src/clj/game/core-rules.clj
+++ src/clj/game/core-rules.clj
@@ -47,10 +47,9 @@
 (defn remaining-draws
   "Calculate remaining number of cards that can be drawn this turn if a maximum exists"
   [state side]
-  (let [active-player (get-in @state [:active-player])]
-    (when-let [max-draw (get-in @state [active-player :register :max-draw])]
-      (let [drawn-this-turn (get-in @state [active-player :register :drawn-this-turn] 0)]
-        (max (- max-draw drawn-this-turn) 0)))))
+  (when-let [max-draw (get-in @state [side :register :max-draw])]
+    (let [drawn-this-turn (get-in @state [side :register :drawn-this-turn] 0)]
+      (max (- max-draw drawn-this-turn) 0))))

 (defn draw
   "Draw n cards from :deck to :hand."
@@ -58,17 +57,17 @@
   ([state side n] (draw state side n nil))
   ([state side n {:keys [suppress-event] :as args}]
    (let [active-player (get-in @state [:active-player])
-         n (if (get-in @state [active-player :register :max-draw])
+         n (if (and (= side active-player) (get-in @state [active-player :register :max-draw]))
              (min n (remaining-draws state side))
              n)
          deck-count (count (get-in @state [side :deck]))]
      (when (and (= side :corp) (> n deck-count))
        (win-decked state))
-     (when-not (get-in @state [active-player :register :cannot-draw])
+     (when-not (and (= side active-player) (get-in @state [side :register :cannot-draw]))
        (let [drawn (zone :hand (take n (get-in @state [side :deck])))]
          (swap! state update-in [side :hand] #(concat % drawn))
          (swap! state update-in [side :deck] (partial drop n))
-         (swap! state update-in [active-player :register :drawn-this-turn] (fnil #(+ % n) 0))
+         (swap! state update-in [side :register :drawn-this-turn] (fnil #(+ % n) 0))
          (when (and (not suppress-event) (pos? deck-count))
            (trigger-event state side (if (= side :corp) :corp-draw :runner-draw) n))
          (when (= 0 (remaining-draws state side))


Turns out we already have a function for extracting namespace prefixes from SPARQL queries 🙈

--- src/clj/sparqlab/sparql.clj
+++ src/clj/sparqlab/sparql.clj
@@ -232,11 +232,6 @@
      :query-string (serialize-query parsed-query)
      :query-type (get-query-type parsed-query)}))

-(defn query-prefixes
-  "Get namespace prefixes from `query` as a map."
-  [^Query query]
-  (into {} (.. query getPrefixMapping getNsPrefixMap)))
-
 (defn select-query
   "Execute SPARQL SELECT `query` on the `model`."
   [^Model model


wip TCO

wip TCO

--- src/clj/wombat/compiler.clj
+++ src/clj/wombat/compiler.clj
@@ -437,6 +437,7 @@
           env {:params (take-while before-rest params)
                :closed-overs fv
                :locals {}
+               :recur-sym *current-define* ;; TODO: Enable named lambdas
                :thistype (Type/getObjectType fqname)
                :restarg restarg}]
       (. cw visit Opcodes/V1_7 Opcodes/ACC_PUBLIC fqname nil "java/lang/Object" ifaces)
@@ -752,6 +753,19 @@
     (doseq [i insns]
       (emit-jvm labeled-env context gen i))))

+(defn emit-tail-call
+  [{:keys [recur-sym] :as env} ^GeneratorAdapter gen [fun & args :as call]]
+  (if (= fun recur-sym)
+    (when (or (and restarg (not (>= (count args) (count params))))
+              (not= (count args) (count params)))
+      (throw (IllegalArgumentException.
+              (str "Wrong number of args (" (count args) " for " (count params) (when restarg "+") ")"))))
+    (dotimes [n (count params)]
+      (emit env :context/expression (nth args n))
+      (. gen storeArg n))
+    (when-let [extra (seq (drop (count params) args))]
+      )))
+
 (defmethod emit-seq -invoke-
   [env context ^GeneratorAdapter gen [fun & args :as call]]
   (when (nil? fun)
@@ -759,31 +773,32 @@
   (debug "emitting invoke:" call)
   (debug "context:" context)

-  (if (keyword? fun)
-    (let [fn-sym (symbol (or (namespace fun) "clojure.core") (name fun))]
-      (debug "keyword invoke: " fun)
-      (when-not (clean-resolve fn-sym)
-        (throw (IllegalArgumentException. (str "Unable to resolve clojure symbol " fn-sym))))
-
-      (emit-var gen fn-sym)
-      (doseq [a args]
-        (emit env :context/expression gen a))
-      (. gen invokeVirtual (asmtype clojure.lang.Var) (Method. "invoke" object-type (into-array Type (repeat (count args) object-type)))))
-    (do
-      (emit env :context/expression gen fun)
-      (. gen dup)
-      (. gen checkCast ilambda-type)
-      (AsmUtil/pushInt gen (count args))
-      (. gen invokeInterface ilambda-type (Method/getMethod "java.lang.invoke.MethodHandle getHandle(int)"))
-      (. gen swap)
-
-      (doseq [a args]
-        (emit env :context/expression gen a))
-      (. gen invokeVirtual (asmtype MethodHandle)
-         (Method. "invoke" object-type (into-array Type (cons ilambda-type (repeat (count args) object-type)))))))
-
-  (when (= context :context/statement)
-    (. gen pop)))
+  (if (= context :context/return)
+    (emit-tail-call env gen call)
+    (if (keyword? fun)
+      (let [fn-sym (symbol (or (namespace fun) "clojure.core") (name fun))]
+        (debug "keyword invoke: " fun)
+        (when-not (clean-resolve fn-sym)
+          (throw (IllegalArgumentException. (str "Unable to resolve clojure symbol " fn-sym))))
+
+        (emit-var gen fn-sym)
+        (doseq [a args]
+          (emit env :context/expression gen a))
+        (. gen invokeVirtual (asmtype clojure.lang.Var) (Method. "invoke" object-type (into-array Type (repeat (count args) object-type)))))
+      (do
+        (emit env :context/expression gen fun)
+        (. gen dup)
+        (. gen checkCast ilambda-type)
+        (AsmUtil/pushInt gen (count args))
+        (. gen invokeInterface ilambda-type (Method/getMethod "java.lang.invoke.MethodHandle getHandle(int)"))
+        (. gen swap)
+
+        (doseq [a args]
+          (emit env :context/expression gen a))
+        (. gen invokeVirtual (asmtype MethodHandle)
+           (Method. "invoke" object-type (into-array Type (core/cons ilambda-type (repeat (count args) object-type)))))))
+    (when (= context :context/statement)
+      (. gen pop))))

 (defn compile-and-load
   ^Class [form]


comments

comments

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -27,16 +27,22 @@
 (def player? (set cst/players))
 (def cell? (conj player? :wall :empty))

-(defn board? [b]
+(defn board?
+  "A board is a vector of vector of cells"
+  [b]
   (every? #(every? cell? %) b))

-(defn coord? [p]
+(defn coord?
+  "A cell is a pair of integer"
+  [p]
   (and
     (integer? (first p))
     (integer? (second p))
     (= 2 (count p))))

-(defn move? [m]
+(defn move?
+  "A move is a map of coordinate, cell takens, a looser an a winner"
+  [m]
   (and
     (coord? (:move m))
     (every? coord? (:taken m))


Removing leftover code from project creation.

--- src/cmr_oracle_lib/core.clj
+++ src/cmr_oracle_lib/core.clj
@@ -1,6 +0,0 @@
-(ns cmr-oracle-lib.core)
-
-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))


clearing use

clearing use


rest PUT files back where they came from


Refactor extensions

Refactor extensions

--- src/discuss/extensions.cljs
+++ src/discuss/extensions.cljs
@@ -1,5 +1,12 @@
 (ns discuss.extensions
   "Extending JS types to be better accessible in CLJS.")
+
+(def types [js/NodeList
+            js/HTMLCollection
+            js/HTMLDocument
+            js/HTMLDivElement
+            js/HTMLParagraphElement
+            js/HTMLSpanElement])

 (defn extend-type-fn
   "Given a type t, apply extensions."
@@ -29,9 +36,4 @@
       ([array f start]
        (ci-reduce array f start)))))

-(extend-type-fn js/NodeList)
-(extend-type-fn js/HTMLCollection)
-(extend-type-fn js/HTMLDocument)
-(extend-type-fn js/HTMLDivElement)
-(extend-type-fn js/HTMLParagraphElement)
-(extend-type-fn js/HTMLSpanElement)+(doall (map #(extend-type-fn %) types))


Update parent ixes during rotate

Update parent ixes during rotate

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -158,7 +158,11 @@
                         (aset (.-keys parent) parent-ix (.pop left-keys))
                         (aset (.-vals parent) parent-ix (.pop left-vals))
                         (when children
-                          (.unshift children (.pop left-children)))
+                          (let [stray-child (.pop left-children)]
+                            (.unshift children stray-child)
+                            (set! (.-parent stray-child) this)
+                            (dotimes [ix (alength children)]
+                              (set! (.-parent-ix (aget children ix)) ix))))
                         (set! lower (aget keys 0))
                         (set! (.-upper left-node) (aget left-keys (- (alength left-keys) 1))))
                       (.rotate-right! this min-keys)))
@@ -176,7 +180,10 @@
                          (aset (.-keys parent) parent-ix (.shift right-keys))
                          (aset (.-vals parent) parent-ix (.shift right-vals))
                          (when children
-                           (.push children (.shift right-children)))
+                           (let [stray-child (.shift right-children)]
+                             (.push children stray-child)
+                             (set! (.-parent stray-child) this)
+                             (set! (.-parent-ix stray-child) (- (alength children) 1))))
                          (set! upper (aget keys (- (alength keys) 1)))
                          (set! (.-lower right-node) (aget right-keys 0)))
                        (.merge! this min-keys)))
@@ -379,6 +386,7 @@

 ;; TODO iterator tests

+;; root is getting lost somehow
 (apply run-denotational-prop [1 [[:assoc! 0 0] [:assoc! 1 0] [:assoc! 4 0] [:assoc! 2 0] [:assoc! -1 0] [:assoc! 3 0] [:assoc! -2 0] [:dissoc! 0] [:assoc! 0 0]]])

 (comment


додано функцію час=time

додано функцію час=time

--- src/uawa/core.clj
+++ src/uawa/core.clj
@@ -79,7 +79,7 @@
 (функція друкуй "див. println" [& більше]  (binding [*print-readably* nil] (apply prn більше)))
 (use 'clojure.pprint)
 (функція друкуй-таблицю "див. print-table" ([текст]  (print-table текст)) ([заголовок текст]  (print-table заголовок текст)))
-(defmacro час-виконання "див. time" [вираз] `(time ~вираз))
+(defmacro час "див. time" [вираз] `(time ~вираз))

 ;; UA
 (запис Ціна [кількість валюта] )


More on records.

More on records.

--- test/com/nomistech/clojure_the_language/protocols_and_records_test.clj
+++ test/com/nomistech/clojure_the_language/protocols_and_records_test.clj
@@ -32,7 +32,6 @@
 ;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ;;;; Q. When to use `MyRecord.` and when to use `->MyRecord`?
 ;;;; A.  `MyRecord.` is not a function.
-;;;;     So generally use `->MyRecord` (the Clojure thing, not the Java thing).
 ;;;; See below.

 (fact
@@ -43,6 +42,12 @@

 ;;; This does not compile:
 ;;;   (map MyRecord. [1 2 3] [10 20 30])
+
+;;;; Also, `->MyRecord` is available when you require/use this
+;;;; namespace, so the client doesn't have to use import as well.
+
+;;;; So generally use `->MyRecord`.
+;;;; (Use the Clojure thing, not the Java thing).

 ;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


center pitch bend range around 0

center pitch bend range around 0


Playing with indexing-push-back-reader.

Playing with indexing-push-back-reader.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -1,8 +1,32 @@
 (ns cbfg.zgo.core
-  (:gen-class))
+  (:gen-class)
+  (:require [clojure.tools.reader :as r]
+            [clojure.tools.reader.reader-types :as rt]))
+
+(defn prm [x]
+  (binding [*print-meta* true]
+    (pr x)))
+
+(defn read-file [fname]
+  (let [ipbr (rt/indexing-push-back-reader
+              (java.io.PushbackReader. (clojure.java.io/reader fname)) 10 fname)]
+    (binding [*read-eval* false]
+      (let [r (r/read ipbr false :eof)]
+        (prm r))
+      (let [r (r/read ipbr false :eof)]
+        (prm r))
+      (let [r (r/read ipbr false :eof)]
+        (prm r))
+      (let [r (r/read ipbr false :eof)]
+        (prm r))
+      (let [r (r/read ipbr false :eof)]
+        (prm r))
+        )))

 (defn -main
   "some docstring"
   []
-  (println "hello world from zgo"))
+  (println "hello world from zgo")
+  (read-file "src/cbfg/misc.cljs"))

+


Shorter emit-merged-lines.

Shorter emit-merged-lines.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -69,15 +69,10 @@
          slines numbered-slines]
     (let [oline (first olines)
           [i sline] (first slines)]
-      (cond
-       (and oline sline) (do (println (ljust OUT-WIDTH oline) "//" i sline)
-                             (recur (rest olines) (rest slines)))
-       (seq oline) (do (println oline)
-                       (recur (rest olines) (rest slines)))
-
-       (seq sline) (do (println (ljust OUT-WIDTH "") "//" i sline)
-                       (recur (rest olines) (rest slines)))
-       :done nil))))
+      (when (or oline sline)
+        (do (println (ljust OUT-WIDTH (or oline ""))
+                     (when sline (str "// " i " " sline)))
+            (recur (rest olines) (rest slines)))))))

 (defn emit [slines pmodel-in]
   (loop [last-line 0
@@ -88,7 +83,7 @@
           (doseq [[i line] (numbered-lines slines
                                            (inc last-line)
                                            (dec sline-beg))]
-            (println "///" i line)))
+            (println "//" i line)))
         (emit-merged-lines out (numbered-lines slines
                                                sline-beg
                                                sline-end))


Start enable bluetooth after starting BleManager

--- src/re_natal_esp32control_app/devices/ble.cljs
+++ src/re_natal_esp32control_app/devices/ble.cljs
@@ -19,12 +19,12 @@
 (defn start-ble-manager []
   (-> (.start BleManager {:showAlert false :allowDuplication false})
       (.then (fn []
+               (.enableBluetooth BleManager)
                #_(js/alert "module initialized"))))
   #_(.addListener ble-manager-emitter "BleManagerStopScan" #(js/alert "stopped scanning"))
   (.addListener ble-manager-emitter "BleManagerDiscoverPeripheral" handle-discovered-peripheral))

 (defn init []
-  (.enableBluetooth BleManager)
   (when (= (.-OS platform) "android")
     (if (< (.-Version platform) 23)
       (start-ble-manager)


Refactor watchers to make them more flexible

--- src/civil_ci/data.clj
+++ src/civil_ci/data.clj
@@ -45,16 +45,33 @@
     (do (println "Committing:" message)
         (git/git-commit (:git repo) message))))

-(defn- add-config-watcher [reference file repo]
+
+
+
+(defn- add-value-watcher [reference file repo]
   (add-watch reference (fs/absolute-path file)
              (fn [path _ _ new-state]
                (spit path (json/generate-string new-state))
                (add-to repo path))))

+(defn- add-hash-watcher [reference path changed-fn add-fn remove-fn]
+  (add-watch reference path
+             (fn [path _ old-hash new-hash]
+               (let [old-key-set (set (keys old-hash))
+                     new-key-set (set (keys new-hash))
+                     added (difference new-key-set old-key-set)
+                     removed (difference old-key-set new-key-set)
+                     new-keys (keys new-hash)]
+                 (changed-fn new-keys)
+                 (doall (map remove-fn removed))
+                 (doall (map #(add-fn % (new-hash %)) added))))))
+
+
+
 (defn- get-config [file repo]
   (if (fs/exists? file)
     (let [config-ref (atom (json/parse-string (slurp file) true))]
-      (add-config-watcher config-ref file repo)
+      (add-value-watcher config-ref file repo)
       config-ref)))

 (defn get-server-config [path repo]
@@ -75,27 +92,21 @@
     (spit config-file
           (json/generate-string @config))
     (add-to repo (fs/absolute-path config-file))
-    (add-config-watcher config config-file repo)))
+    (add-value-watcher config config-file repo)))

 (defn- remove-job [path id repo]
   (let [job-dir (io/file path id)]
     (fs/delete-dir job-dir)
     (remove-from repo (str (fs/absolute-path job-dir)))))

-(defn- add-jobs-watcher [reference path repo server-config]
-  (add-watch reference path
-             (fn [path _ old-jobs new-jobs]
-               (let [old-jobs-set (set (keys old-jobs))
-                     new-jobs-set (set (keys new-jobs))
-                     added (difference new-jobs-set old-jobs-set)
-                     removed (difference old-jobs-set new-jobs-set)]
-                 (swap! server-config assoc :jobs (keys new-jobs))
-                 (doall (map #(remove-job path % repo) removed))
-                 (doall (map #(add-job path % (new-jobs %) repo) added))))))

 (defn get-job-config [path repo server-config]
   (let [job-config (atom (reduce (assoc-job-config path repo)
                                  {} (:jobs @server-config)))]
-    (add-jobs-watcher job-config path repo server-config)
+    (add-hash-watcher job-config path
+                      #(swap! server-config assoc :jobs %)
+                      #(add-job path %1 %2 repo )
+                      #(remove-job path % repo))
     job-config))

+


no need to turn whatever .getResource returns into a File

--- src/clabango/tags.clj
+++ src/clabango/tags.clj
@@ -1,12 +1,10 @@
 (ns clabango.tags
-  (:use [clojure.java.io :only [file]]
-        [clabango.filters :only [context-lookup]]))
+  (:use [clabango.filters :only [context-lookup]]))

 (defn load-template [template]
   (-> (Thread/currentThread)
       (.getContextClassLoader)
-      (.getResource template)
-      file))
+      (.getResource template)))

 (defn get-block-status [context]
   (::block-info context))


modify add-prop to accept optional :placed key for advancement tokens

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -460,12 +460,15 @@
         (swap! state assoc-in [:runner :run-credit] 0)
         (swap! state assoc :run nil))))

-(defn add-prop [state side card key n]
-  (update! state side (update-in card [key] #(+ (or % 0) n)))
-  (if (= key :advance-counter)
-    (do (trigger-event state side :advance (get-card state card))
-        (when (and (#{"ICE"} (:type card)) (:rezzed card)) (update-ice-strength state side card)))
-    (trigger-event state side :counter-added (get-card state card))))
+(defn add-prop
+  ([state side card key n] (add-prop state side card key n nil))
+  ([state side card key n {:keys [placed] :as args}]
+    (update! state side (update-in card [key] #(+ (or % 0) n)))
+    (if (= key :advance-counter)
+      (do (when (and (#{"ICE"} (:type card)) (:rezzed card)) (update-ice-strength state side card))
+          (when (not placed)
+            (trigger-event state side :advance (get-card state card))))
+      (trigger-event state side :counter-added (get-card state card)))))

 (defn set-prop [state side card & args]
   (update! state side (apply assoc (cons card args))))


add turn state flags

add turn state flags

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -108,6 +108,18 @@
 ;Clear the current run register
 (defn clear-run-register! [state]
   (swap! state assoc-in [:register :current-run] nil)
+  )
+
+(defn register-turn-flag! [state flag card]
+  (swap! state assoc-in [:register :current-turn flag] card)
+  )
+
+(defn turn-flag [state flag]
+  (get-in @state [:register :current-turn flag])
+  )
+
+(defn clear-turn-register! [state]
+  (swap! state assoc-in [:register :current-turn] nil)
   )

 (defn register-suppress [state side events card]
@@ -1394,6 +1406,7 @@
       (doseq [a (get-in @state [side :register :end-turn])]
         (resolve-ability state side (:ability a) (:card a) (:targets a)))
       (swap! state assoc :end-turn true)
+      (clear-turn-register! state)
       (swap! state dissoc :turn-events))))

 (defn purge [state side]


fix events handling on hosted cards

fix events handling on hosted cards

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -988,7 +988,9 @@

 (defn host
   ([state side card target] (host state side card target nil))
-  ([state side card {:keys [zone cid host] :as target} {:keys [facedown] :as options}]
+  ([state side card {:keys [zone cid host installed] :as target} {:keys [facedown] :as options}]
+   (when installed
+     (unregister-events state side target))
    (doseq [s [:runner :corp]]
      (if host
        (when-let [host-card (some #(when (= (:cid host) (:cid %)) %)
@@ -1002,6 +1004,8 @@
                          :facedown facedown
                          :zone '(:onhost))] ;; hosted cards should not be in :discard or :hand etc
      (update! state side (update-in card [:hosted] #(conj % c)))
+     (when-let [events (:events (card-def target))]
+       (register-events state side events c))
      c)))

 (defn runner-install


fix for a broker server-side inflate implemention, for explaination please see http://stackoverflow.com/questions/3932117/handling-http-contentencoding-deflate

--- src/clj_http/util.clj
+++ src/clj_http/util.clj
@@ -59,7 +59,11 @@
   "Returns a zlib inflate'd version of the given byte array."
   [b]
   (when b
-    (IOUtils/toByteArray (InflaterInputStream. (ByteArrayInputStream. b)))))
+    (try
+      (IOUtils/toByteArray (InflaterInputStream. (ByteArrayInputStream. b)))
+      (catch java.util.zip.ZipException e ;broken inflate implementation server-side,
+                                          ; see http://stackoverflow.com/questions/3932117/handling-http-contentencoding-deflate
+        (IOUtils/toByteArray (InflaterInputStream. (ByteArrayInputStream. b) (java.util.zip.Inflater. true)))))))

 (defn deflate
   "Returns a deflate'd version of the given byte array."


Always instantiate new DOM nodes, and pass those nodes to the user-specified `enter` fn.

This is consistent with `update` and `exit`, which also receive the actual node on the DOM.

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -145,8 +145,11 @@
                     (merge-dom! (:node old) new-node
                                 :defer-attr defer-attr))))

-              (if (enter d idx new-dom-node)
-                (append! container new-node)))))
+              ;;instantiate new node on the DOM so it can be manipulated in the user-specified `enter` fn.
+              (let [new-dom-node (append! "body" new-node)]
+                (if (enter d idx new-dom-node)
+                  (append! container new-dom-node) ;;move new node to container
+                  (remove! new-dom-node))))))

     ;;Run post-fn, if it was given
     (if post-fn


Slow down dragging.

Slow down dragging.

--- src/cljs/svg/app.cljs
+++ src/cljs/svg/app.cljs
@@ -153,8 +153,8 @@
               (.addEventListener drag
                goog.fx.Dragger.EventType/DRAG
                (fn [b]
-                 (let [dx (-> b .-dragger .-deltaX)
-                       dy (-> b .-dragger .-deltaY)
+                 (let [dx (-> b .-dragger .-deltaX (/ 20) (Math/round))
+                       dy (-> b .-dragger .-deltaY (/ 20) (Math/round))
                        x (x-constraint (+ dx @(:x local-state)))
                        y (y-constraint (+ dy @(:y local-state)))]
                    (emit :object-moved {:x x :y y}))))


a whole new world

a whole new world

--- ros/angelic_planning/src/ros/world.clj
+++ ros/angelic_planning/src/ros/world.clj
@@ -399,7 +399,7 @@
 	     :type :surface :surface (make-xy-region [12.12 12.52] [25.6 26.2])
 	     :height 0.6}
     "desk" {:xyz [13.32 24.9 0.3]  :rpy [0 0 0]
-	     :def {:class :box :name "table-top" :size [1.00 1.0 0.6]}
+	     :def {:class :box :name "table-top" :size [1.00 2.0 0.6]}
 	     :type :surface :surface (make-xy-region [13.2 13.4] [24.9 25.0])
 	     :height 0.6}


remove message options animation (dead code)

--- src/status_im/ui/screens/chat/bottom_info.cljs
+++ src/status_im/ui/screens/chat/bottom_info.cljs
@@ -1,16 +1,6 @@
 (ns status-im.ui.screens.chat.bottom-info
-  (:require [reagent.core :as reagent]
-            [status-im.ui.components.animation :as anim]
-            [status-im.ui.components.react :as react]
+  (:require [status-im.ui.components.react :as react]
             [status-im.ui.screens.chat.styles.main :as styles]))
-
-(defn- container-animation-logic
-  [{:keys [to-value val]}]
-  (fn [_]
-    (anim/start
-     (anim/spring val {:toValue  to-value
-                       :friction 6
-                       :tension  40}))))

 (defn overlay
   [{:keys [on-click-outside]} items]
@@ -21,16 +11,6 @@
    items])

 (defn container
-  [height & _]
-  (let [anim-value    (anim/create-value 1)
-        context       {:to-value height
-                       :val      anim-value}
-        on-update     (container-animation-logic context)]
-    (reagent/create-class
-     {:component-did-update
-      on-update
-      :display-name "container"
-      :reagent-render
-      (fn [height & children]
-        [react/animated-view {:style (styles/bottom-info-container height)}
-         (into [react/view] children)])})))
+  [height & children]
+  [react/view {:style (styles/bottom-info-container height)}
+   (into [react/view] children)])


another attempt at fixing parallel access to a future

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -21,8 +21,8 @@

 (def medium-model (promise))
 (defn medium []
-  (if (and (realized? medium-model)
-           (not (nil? medium-model)))
+  (if (and (not (nil? medium-model))
+           (realized? medium-model))
     @medium-model
     @(deliver medium-model (grammar/medium))))


Default to :keys if nothing else is available in an update

--- src/hildebrand/internal/streams.clj
+++ src/hildebrand/internal/streams.clj
@@ -34,7 +34,7 @@
                 [stream-view-type])]
     (into [event-name]
       (for [k ks]
-        (response/->item (m k))))))
+        (response/->item (some m [k :keys]))))))

 (defn ->record [{:keys [dynamodb event-name] :as m}]
   (with-meta


add TODO

add TODO

--- src/babel/engine.cljc
+++ src/babel/engine.cljc
@@ -27,6 +27,7 @@
            (generate-from-request request)))))

 ;; TODO: use a option map/destructuring thing.
+;; TODO: (defn generate [...] (take 1 (generate-all ...)))
 (defn generate [spec language-model & [{add-subcat :add-subcat
                                         do-enrich :do-enrich}]]
   (let [do-enrich (if do-enrich do-enrich true)


Add Parse->string function to layout.

Add Parse->string function to layout.

--- src/incise/layouts/core.clj
+++ src/incise/layouts/core.clj
@@ -1,4 +1,6 @@
 (ns incise.layouts.core
+  (:require [incise.parsers.core]
+            [incise.config :as conf])
   (:refer-clojure :exclude [get]))

 (def layouts (atom {}))
@@ -11,6 +13,10 @@
 (defn get [layout-name]
   (@layouts (name layout-name)))

+(defn Parse->string
+  [^incise.parsers.core.Parse parse-data]
+  ((get (:layout parse-data)) conf/get (:content parse-data)))
+
 (defn register
   "Register a layout function to a shortname"
   [short-name layout-fn]


Reimplement layouts.core/register like parsers.core/register.

--- src/incise/layouts/core.clj
+++ src/incise/layouts/core.clj
@@ -20,7 +20,6 @@
 (defn register
   "Register a layout function to a shortname"
   [short-names layout-fn]
-  (dosync
-    (doseq [short-name short-names]
-      (swap! layouts
-             assoc (name short-name) layout-fn))))
+  (swap! layouts
+         merge (zipmap (map name short-names)
+                       (repeat layout-fn))))


Filter all files to book file types only

--- src/bookshelf/core.clj
+++ src/bookshelf/core.clj
@@ -7,8 +7,15 @@
   (:use [compojure.core :refer :all])
   (:use [compojure.route :as route]))

+(def library-dir "/Users/dan/GoogleDrive/Literature")
+
+(defn is-book [file]
+  (let [path (.getPath file)]
+    (or (.endsWith path ".pdf")
+        (.endsWith path ".epub"))))
+
 (defn library-files []
-  (file-seq (clojure.java.io/file "/Users/dan/GoogleDrive/Literature/iPad")))
+  (filter #'is-book (file-seq (clojure.java.io/file library-dir))))

 (defroutes handler
   (GET "/" [] (str/join "<br>" (library-files)))


Improve header encoding on jwe.

Improve header encoding on jwe.

--- src/buddy/sign/jwe.clj
+++ src/buddy/sign/jwe.clj
@@ -150,15 +150,14 @@
 ;; Implementation details
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn generate-header
-  [{:keys [alg enc zip]}]
-  (let [data (merge {:alg (condp = alg
-                            :dir "dir"
-                            (str/upper-case (name alg)))
-                     :enc (str/upper-case (name enc))}
-                    (when (not= zip ::none)
-                      {:zip (str/upper-case (name enc))}))]
-    (-> (json/generate-string data)
+(defn- encode-header
+  [{:keys [alg typ enc zip]}]
+  (let [alg (if (= alg :dir) "dir" (str/upper-case (name alg)))
+        typ (.toUpperCase (name typ))
+        enc (.toUpperCase (name enc))
+        header (merge {:alg alg :typ typ :enc enc}
+                      (when zip {:zip "DEF"}))]
+    (-> (json/generate-string header)
         (codecs/str->bytes))))

 (defn- parse-header


Common timer component logic in self-refreshing-component factory.

--- ui/src/ui/core.cljs
+++ ui/src/ui/core.cljs
@@ -43,118 +43,80 @@
                    :cx x
                    :cy y
                    :fill fill}))
-
-(defn timer-minutes [data owner]
-  (reify
-    IDisplayName
-    (display-name [_]
-      "Minutes on the timer")
-    IWillMount
-    (will-mount [_]
-      (go-loop []
-        (let [data (om/root-cursor app-state)]
-          (when (contains? (:timer data) :Start)
-            (let [start (time-coerce/to-date (get-in data [:timer :Start]))
-                  interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
-              (om/update-state! owner :elapsed-minutes #(mod (/ interval-seconds 60) 60))))
-          (<! (async/timeout 1000))
-          (recur))))
-    IInitState
-    (init-state [_]
-      {:elapsed-minutes 0})
-    IRenderState
-    (render-state [owner {min :elapsed-minutes}]
-      (let [{x :x y :y r :r} (:dimensions data)]
-        (pie x y r "#d9d9d9" (* 6 10 min))))))

-(defn timer-hours [data owner]
-  (reify
-    IDisplayName
-    (display-name [_]
-      "Hours on the timer")
-    IWillMount
-    (will-mount [_]
-      (go-loop []
-        (let [data (om/root-cursor app-state)]
-          (when (contains? (:timer data) :Start)
-            (let [start (time-coerce/to-date (get-in data [:timer :Start]))
-                  interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
-              (om/update-state! owner :elapsed-hours #(mod (/ interval-seconds 60 60) 24))))
-          (<! (async/timeout 10000))
-          (recur))))
-    IInitState
-    (init-state [_]
-      {:elapsed-hours 0})
-    IRenderState
-    (render-state [owner {hr :elapsed-hours}]
-      (let [{x :x y :y r :r} (:dimensions data)]
-        (pie x y (/ r 1.4) "#cccccc" (* 30 10 hr))))))
+(defn self-refreshing-component [& {:keys [name interval-millis render-fn]}]
+  (fn [data owner]
+    (reify
+      IDisplayName
+      (display-name [_]
+        name)
+      IWillMount
+      (will-mount [_]
+        (go-loop []
+          (let [data (om/root-cursor app-state)]
+            (when (contains? (:timer data) :Start)
+              (let [start (time-coerce/to-date (get-in data [:timer :Start]))
+                    interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
+                (om/update-state! owner :elapsed-seconds #(mod interval-seconds 60))
+                (om/update-state! owner :elapsed-minutes #(mod (/ interval-seconds 60) 60))
+                (om/update-state! owner :elapsed-hours #(mod (/ interval-seconds 60 60) 24))))
+            (<! (async/timeout interval-millis))
+            (recur))))
+      IInitState
+      (init-state [_]
+        {:elapsed-seconds 0
+         :elapsed-minutes 0
+         :elapsed-hours 0})
+      IRenderState
+      (render-state [owner state]
+        (render-fn data state)))))

-(defn timer-seconds [data owner]
-  (reify
-    IDisplayName
-    (display-name [_]
-      "Seconds on the timer")
-    IWillMount
-    (will-mount [_]
-      (go-loop []
-        (let [data (om/root-cursor app-state)]
-          (when (contains? (:timer data) :Start)
-            (when-not (contains? (om/get-state owner) :start)
-              (om/set-state! owner :start (time-coerce/to-date (get-in data [:timer :Start]))))
-            (let [start (om/get-state owner :start)
-                  interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
-              (om/update-state! owner :elapsed-seconds #(mod interval-seconds 60))))
-          (<! (async/timeout 50))
-          (recur))))
-    IInitState
-    (init-state [_]
-      {:elapsed-seconds 0})
-    IRenderState
-    (render-state [owner {sec :elapsed-seconds}]
-      (let [{x :x y :y r :r} (:dimensions data)]
-        (dom/line #js {:x1 (+ x (math/angleDx (* 6 sec) (/ r 1.4)))
-                       :y1 (+ y (math/angleDy (* 6 sec) (/ r 1.4)))
-                       :x2 (+ x (math/angleDx (* 6 sec) r))
-                       :y2 (+ y (math/angleDy (* 6 sec) r))
-                       :style #js {:stroke "#bfbfbf"
-                                   :strokeWidth "4px"}
-                       :transform (str "rotate(-90," x "," y")")})))))
+(def timer-minutes
+  (self-refreshing-component
+   :name "Minutes on the timer"
+   :interval-millis 1000
+   :render-fn (fn [data {min :elapsed-minutes}]
+                (let [{x :x y :y r :r} (:dimensions data)]
+                  (pie x y r "#d9d9d9" (* 6 10 min))))))

-(defn timer-text [data owner]
-  (reify
-    IDisplayName
-    (display-name [_]
-      "The time text")
-    IInitState
-    (init-state [_]
-      {:elapsed-seconds 0
-       :elapsed-minutes 0
-       :elapsed-hours 0})
-    IWillMount
-    (will-mount [_]
-      (go-loop []
-        (let [data (om/root-cursor app-state)]
-          (when (contains? (:timer data) :Start)
-            (let [start (time-coerce/to-date (get-in data [:timer :Start]))
-                  interval-seconds (/ (time/in-millis (time/interval start (time/now))) 1000)]
-              (om/update-state! owner :elapsed-minutes #(mod (/ interval-seconds 60) 60))
-              (om/update-state! owner :elapsed-hours #(mod (/ interval-seconds 60 60) 24))))
-          (<! (async/timeout 1000))
-          (recur))))
-    IRenderState
-    (render-state [_ {min :elapsed-minutes hr :elapsed-hours}]
-      (let [{x :x y :y} (:dimensions data)
-            min-only (= 0 (int hr))]
-        (dom/text #js {:x (if min-only
-                            (- x 50)
-                            (- x 130))
-                       :y (+ y 25)
-                       :fill "blue"
-                       :style #js {:fontSize "90px"}}
-                  (if min-only
-                    (str (int min) "m")
-                    (str (int hr) "h " (int min) "m")))))))
+(def timer-hours
+  (self-refreshing-component
+   :name "Hours on the timer"
+   :interval-millis 10000
+   :render-fn (fn [data {hr :elapsed-hours}]
+                (let [{x :x y :y r :r} (:dimensions data)]
+                  (pie x y (/ r 1.4) "#cccccc" (* 30 10 hr))))))
+
+(def timer-seconds
+  (self-refreshing-component
+   :name "Seconds on the timer"
+   :interval-millis 50
+   :render-fn (fn [data {sec :elapsed-seconds}]
+                (let [{x :x y :y r :r} (:dimensions data)]
+                  (dom/line #js {:x1 (+ x (math/angleDx (* 6 sec) (/ r 1.4)))
+                                 :y1 (+ y (math/angleDy (* 6 sec) (/ r 1.4)))
+                                 :x2 (+ x (math/angleDx (* 6 sec) r))
+                                 :y2 (+ y (math/angleDy (* 6 sec) r))
+                                 :style #js {:stroke "#bfbfbf"
+                                             :strokeWidth "4px"}
+                                 :transform (str "rotate(-90," x "," y")")})))))
+
+(def timer-text
+  (self-refreshing-component
+   :name "Timer text"
+   :interval-millis 1000
+   :render-fn (fn [data {min :elapsed-minutes hr :elapsed-hours}]
+                (let [{x :x y :y} (:dimensions data)
+                      min-only (= 0 (int hr))]
+                  (dom/text #js {:x (if min-only
+                                      (- x 50)
+                                      (- x 130))
+                                 :y (+ y 25)
+                                 :fill "blue"
+                                 :style #js {:fontSize "90px"}}
+                            (if min-only
+                              (str (int min) "m")
+                              (str (int hr) "h " (int min) "m")))))))

 (defn timer-view [data owner]
   (reify


rethink driver: remaining code committed"

--- src/basilisk/db/rethink.clj
+++ src/basilisk/db/rethink.clj
@@ -11,10 +11,15 @@
 ;; Connection atom contains the connection object
 (def connection (atom nil))

+;; Private API

-;; Public API
-(defn connect
-  "Connect ro rethink cluster"
+(defn- connected?
+  "Check the connectivity to database"
+  []
+  (not (nil? @connection)))
+
+(defn- _connect
+  "Private connect function"
   []
   (logger/debug (host))
   (logger/debug (port))
@@ -23,6 +28,14 @@
                         :port (port)
                         :db   (db))]
     (swap! connection (fn [_] conn))))
+
+
+;; Public API
+(defn connect
+  "Connect ro rethink cluster"
+  []
+  (when (not (connected?))
+    (_connect)))

 (defn initialize
   "Initialize the database by creating it and its data structures."
@@ -33,23 +46,27 @@
 (defn create-table
   "Create a table with given name and specs"
   ([name]
+   (connect)
    ;; Query execution
    (-> (r/db (db))
        (r/table-create name)
        (r/run @connection)))

   ([name spec-map]
-  (let [index-name (get spec-map :index-name)
-        index-fn   (get spec-map :index-fn (fn [row] (r/get-field row index-name)))]
-    ;; Query execution
-    (-> (r/db (db))
-        (r/table-create name)
-        (when (not (nil? index-name))
-          (r/index-create index-name index-fn))
-        (r/run @connection)))))
+   (connect)
+   (let [index-name (get spec-map :index-name)
+         index-fn   (get spec-map :index-fn (fn [row] (r/get-field row index-name)))]
+     ;; Query execution
+     (-> (r/db (db))
+         (r/table-create name)
+         (when (not (nil? index-name))
+           (r/index-create index-name index-fn))
+         (r/run @connection)))))

 (defn disconnect
   "Disconnect from rethink cluster"
   []
-  (r/close @connection)
-  (reset! connection nil))
+  (when (connected?)
+    (logger/debug "Disconnected from rethink")
+    (r/close @connection)
+    (reset! connection nil)))


working out what queries should be

working out what queries should be

--- src/main/cljs/prochaine/client.cljs
+++ src/main/cljs/prochaine/client.cljs
@@ -127,14 +127,47 @@
   (d/transact! conn
                seed-data))

+(comment
+  ;; NOTES:
+  ;; table-store example
+  (om.next.stores/tables-pull
+    {:app {:app/title "Hello World!" :app/state [0 1 2]}
+     :app/state [{:state/count 0}
+                 {:state/count 0}
+                 {:state/count 0}]}
+    [{:app [:app/title {:app/state [:state/count]}]}])
+  {:app {:app/title "Hello World!", :app/state [{:state/count 0} {:state/count 0} {:state/count 0}]}}
+
+  ;; query we want to satisfy:
+  (om/query ContactList)
+  [{:app/contacts [:person/first-name
+                   :person/last-name
+                   {:person/telephone [:telephone/number]}
+                   {:person/address [:address/street
+                                     :address/city
+                                     :address/zipcode]}]}]
+  ;; expect something like this:
+  [{:app/contacts [{:person/first-name "Bob"
+                    :person/last-name "Smith"
+                    {:person/telephone [{:telephone/number "111-111-1111"}
+                                        {:telephone/number "222-222-2222"}]}
+                    {:person/address [{:address/street "Maple Street"
+                                       :address/city "Boston"
+                                       :address/state "Massachusetts"
+                                       :address/zipcode "11111"}]}}]}]
+  ;; ds query we need to generate:
+  (d/q '[:find ])
+  )
+
 ;; ============================================================
 ;; AddressInfo Component

 (defui AddressInfo
   static om/IQuery
   (-query [this]
-          ;;'[:address/street :address/city :address/zipcode]
-          '{:app/root [:app/title]})
+          '[:address/street :address/city :address/zipcode]
+          ;;'{:app/root [:app/title]}
+          )
   Object
   (render [this]
     (let [{:keys [:address/street :address/city


Added init-server helper function.

Added init-server helper function.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -173,7 +173,7 @@
    :cur-user-realm "_lobby"
    :cur-user "_anon"})

-(defn lane-state-loop [actx server-state-ch]
+(defn lane-state-loop [actx server-state-ch initial-lane-state]
   (let [req-ch (achan actx)]
     (act lane-state-loop-init actx
          (let [ils initial-lane-state
@@ -240,15 +240,18 @@

 ; --------------------------------------------

-(defn cm-server [server-addr & ports] ; Cluster manager.
+(defn init-server [server-kind server-addr ports
+                   make-server-state initial-lane-state]
   (let [world (:world (prog-base-now))
-        server-state-ch (state-loop world :server-state server-handler
-                                    (make-initial-server-state world))
+        server-state-ch (state-loop world [server-kind server-addr ports]
+                                    server-handler
+                                    (make-server-state world))
         lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          lane-state-ch (lane-state-loop actx server-state-ch)
+                          lane-state-ch (lane-state-loop actx server-state-ch
+                                                         initial-lane-state)
                           lane-state-cb (fn [is-req m lane-ext-state]
                                           (if is-req
                                             (if m
@@ -282,58 +285,18 @@
                                                     :server-conn-loop conn-loop)))
              (reset! done true))
         (wait-done done)
-        (prog-evt world :cm-server {:server-addr server-addr :server-port port}
+        (prog-evt world server-kind {:server-addr server-addr :server-port port}
                   #(update-in % [:servers server-addr] conj port)))))
   (addr-override-xy server-addr
                     300 (+ 20 (* 120 (dec (count (:servers (prog-curr-now))))))))

+(defn cm-server [server-addr & ports] ; Cluster manager.
+  (init-server :cm-server server-addr ports
+               make-initial-server-state initial-lane-state))
+
 (defn dm-server [server-addr & ports] ; Data manager.
-  (let [world (:world (prog-base-now))
-        server-state-ch (state-loop world [:kv-server-state server-addr ports]
-                                    server-handler
-                                    (make-initial-server-state world))
-        lane-max-inflight 10
-        lane-buf-size 20
-        make-lane (fn [actx lane-name lane-out-ch]
-                    (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          lane-state-ch (lane-state-loop actx server-state-ch)
-                          lane-state-cb (fn [is-req m lane-ext-state]
-                                          (if is-req
-                                            (if m
-                                              [(assoc m :lane-state-ch lane-state-ch
-                                                      :server-state-ch server-state-ch)
-                                               lane-ext-state]
-                                              (do (act closer actx
-                                                       (aclose closer lane-state-ch))
-                                                  [m lane-ext-state]))
-                                            [m lane-ext-state]))]
-                      (cbfg.fence/make-fenced-pump actx lane-name
-                                                   lane-in-ch lane-out-ch
-                                                   lane-max-inflight false
-                                                   :ext-cb lane-state-cb)
-                      lane-in-ch))
-        conn-loop (fn [actx server-send-ch server-recv-ch close-server-recv-ch]
-                    (cbfg.world.net/server-conn-loop actx
-                                                     server-send-ch
-                                                     server-recv-ch
-                                                     close-server-recv-ch
-                                                     :make-lane-fn make-lane))]
-    (doseq [port ports]
-      (let [done (atom false)]
-        (act port-init world
-             (when-let [listen-result-ch (achan port-init)]
-               (aput port-init (:net-listen-ch (prog-base-now))
-                     [server-addr port listen-result-ch])
-               (when-let [[accept-ch close-accept-ch]
-                          (atake port-init listen-result-ch)]
-                 (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch
-                                                    :server-conn-loop conn-loop)))
-             (reset! done true))
-        (wait-done done)
-        (prog-evt world :kv-server {:server-addr server-addr :server-port port}
-                  #(update-in % [:servers server-addr] conj port)))))
-  (addr-override-xy server-addr
-                    300 (+ 20 (* 120 (dec (count (:servers (prog-curr-now))))))))
+  (init-server :dm-server server-addr ports
+               make-initial-server-state initial-lane-state))

 (defn kv-client [client-addr server-addr server-port]
   (let [world (:world (prog-base-now))


Remove unned checks

Remove unned checks

--- src/bocko_android/core.cljs
+++ src/bocko_android/core.cljs
@@ -36,20 +36,17 @@

 (defn init-canvas!
   [android]
-  (let [last-rendered (atom nil)]
-    (set-create-canvas
-      (fn [color-map raster width height pixel-width pixel-height]
-        (add-watch raster :monitor
-          (fn [_ _ _ new]
-            (let [old @last-rendered]
-              (when-not (or (= old new) (not= new @raster))
-                (let [new-width (/ (.width android) width)]
-                  (draw! color-map
-                         new-width
-                         (* (/ new-width pixel-width) pixel-height)
-                         old new
-                         android))
-                (reset! last-rendered new)))))))))
+  (set-create-canvas
+    (fn [color-map raster width height pixel-width pixel-height]
+      (add-watch raster :monitor
+        (fn [_ _ _ new]
+          (when-not (not= new @raster)
+            (let [new-width (/ (.width android) width)]
+              (draw! color-map
+                     new-width
+                     (* (/ new-width pixel-width) pixel-height)
+                     @raster new
+                     android))))))))

 (defn wait-android
   []


Add type hints (why not?)

Add type hints (why not?)

--- src/boilerpipe_clj/core.clj
+++ src/boilerpipe_clj/core.clj
@@ -7,11 +7,11 @@

   Will use default Boilerpipe Extractor impl if not passed an extractor
   instance as second argument."
-  [source & [extractor]]
+  [^String source & [extractor]]
   (if-let [extractor extractor]
     (.getText extractor source)
     (.getText ext/default-extractor source)))

-(defn get-text-as-html [source & [extractor]]
+(defn get-text-as-html [^String source & [extractor]]
   "Takes HTML as String and returns extracted content in <p> tags."
   (util/wrap-paragraphs (get-text source extractor)))


Added random CAS to storage-set.

Added random CAS to storage-set.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -7,21 +7,24 @@
                               vis-init ]]
             [cbfg.fence :refer [make-fenced-pump]]))

+(defn gen-cas [] (rand-int 0x7fffffff))
+
 (defn storage-get [storage opaque-id key]
   (let [s @storage
         sq (get (:keys s) key)
         change (get (:changes s) sq)]
     (if (and change (not (:deletion change)))
-      {:opaque-id opaque-id :status :ok :key key :val (:val change) :sq sq}
+      {:opaque-id opaque-id :status :ok
+       :key key :sq sq :cas (:cas change) :val (:val change)}
       {:opaque-id opaque-id :status :not-found})))

-(defn storage-set [storage opaque-id key val]
+(defn storage-set [storage opaque-id key prev-sq val]
   (let [storage2 (swap! storage
                         #(-> %
                              (dissoc-in [:changes (get-in % [:keys key :sq])])
                              (assoc-in [:keys key] (:next-sq %))
                              (assoc-in [:changes (:next-sq %)]
-                                       {:key key :val val :sq (:next-sq %)})
+                                       {:key key :sq (:next-sq %) :cas (gen-cas) :val val})
                              (update-in [:next-sq] inc)))]
     {:opaque-id opaque-id :status :ok :key key :sq (dec (:next-sq storage2))}))


small but vital fix to prepare-example

small but vital fix to prepare-example

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -337,6 +337,7 @@
        (utils/sayln :cur-url url)
        (utils/sayln :encountered-documents seen-seq)
        (utils/sayln :corpus-size (count corpus))
+       (utils/sayln :old-corpus-size (count old-corpus))
        (cond (or (stop? {:visited (count visited)
                          :num-leaves num-leaves
                          :queue-size (+ (count content-q)
@@ -380,7 +381,7 @@
                  (utils/sayln :paging pagination-extracted)
                  ;; at leaf, aggressively look for pagination
                  (if-not (and
-                          (<= (count corpus) 100)
+                          (<= (count corpus) 1000)
                           (seen? body old-corpus))
                    (recur {:content-queue (if-not (or (empty? pagination-extracted)
                                                       (nil? pagination-extracted))
@@ -547,7 +548,7 @@
                        identity
                        (map
                         (fn [{a-link :href text :text}]
-                          (when-not (some #{a-link} (:visited acc))
+                          (when-not (some #{a-link} (:new-visited acc))
                             {:url  a-link
                              :path (cons xpath src-path)
                              :src-url url


use site-defaults, secure things don't play nice with nginx ssl

--- src/chat/server/handler.clj
+++ src/chat/server/handler.clj
@@ -46,9 +46,8 @@
         resource-routes
         site-routes
         sync-routes)
-      (-> (if (= (env :environment) "prod")
-            secure-site-defaults
-            site-defaults)
+      (-> site-defaults ; ssl stuff will be handled by nginx
+          (assoc-in [:session :cookie-attrs :secure] true)
           (assoc-in [:session :store] (carmine/carmine-store *redis-conf*
                                                              {:expiration-secs (* 60 60 24 7)
                                                               :key-prefix "lpchat"}))


Fix service crash

Fix service crash

--- android/src/clojure/net/nightweb/pages.clj
+++ android/src/clojure/net/nightweb/pages.clj
@@ -80,7 +80,7 @@
   :on-destroy
   (fn [^Activity this]
     (stop-shutdown-receiver! this)
-    (service/stop-service! (:service @(.state this))))
+    (service/stop-service! this (:service @(.state this))))
   :on-create-options-menu
   (fn [^Activity this menu]
     (menus/create-main-menu this menu true true))
@@ -173,7 +173,7 @@
   :on-destroy
   (fn [^Activity this]
     (stop-shutdown-receiver! this)
-    (service/stop-service! (:service @(.state this))))
+    (service/stop-service! this (:service @(.state this))))
   :on-create-options-menu
   (fn [^Activity this menu]
     (menus/create-main-menu this menu true false))


Fix IFn this-sym

Fix IFn this-sym

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -490,13 +490,13 @@
                                        (mapcat (fn [[f & meths :as form]]
                                                  (if (= psym 'cljs.core/IFn)
                                                    (let [adapt-params (fn [[[targ & args :as sig] & body]]
-                                                                        (let [this-sym (with-meta (gensym "this-sym") {:tag t})]
+                                                                        (let [this-sym (with-meta 'self__ {:tag t})]
                                                                           `(~(vec (cons this-sym args))
                                                                             (this-as ~this-sym
                                                                                (let [~targ ~this-sym]
                                                                                ~@body)))))
                                                          meths (map adapt-params meths)
-                                                         this-sym (with-meta (gensym "this-sym") {:tag t})
+                                                         this-sym (with-meta 'self__ {:tag t})
                                                          argsym (gensym "args")]
                                                      [`(set! ~(prototype-prefix 'call) ~(with-meta `(fn ~@meths) (meta form)))
                                                       `(set! ~(prototype-prefix 'apply)


more disciplined error handling around the configurable bits of the REPL

caught is now a function of three arguments, the throwable, the JavaScript
evaluation environment, and the repl/compiler options.

anywhere a error may be thrown due to user customization wrap in try/catch
and defer to caught

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -537,7 +537,7 @@
 (defn repl-prompt []
   (print (str "ClojureScript:" ana/*cljs-ns* "> ")))

-(defn repl-caught [e opts]
+(defn repl-caught [e repl-env opts]
   (if (and (instance? IExceptionInfo e)
            (#{:js-eval-error :js-eval-exception} (:type (ex-data e))))
     (let [{:keys [type repl-env error form js]} (ex-data e)]
@@ -607,9 +607,12 @@
              is-special-fn? (set (keys special-fns))
              request-prompt (Object.)
              request-exit (Object.)
-             opts (if-let [merge-opts (:merge-opts (-setup repl-env opts))]
-                    (merge opts merge-opts)
-                    opts)
+             opts (try
+                    (if-let [merge-opts (:merge-opts (-setup repl-env opts))]
+                      (merge opts merge-opts)
+                      opts)
+                    (catch Throwable e
+                      (caught e repl-env opts)))
              read-eval-print
              (fn []
                (let [input (binding [*ns* (create-ns ana/*cljs-ns*)
@@ -630,27 +633,34 @@
                        (print value))))))]
          (comp/with-core-cljs opts
            (fn []
-             (when analyze-path
-               (analyze-source analyze-path opts))
-             (evaluate-form repl-env env "<cljs repl>"
-               (with-meta
-                 '(ns cljs.user
-                    (:require [cljs.repl :refer-macros [doc]]))
-                 {:line 1 :column 1})
-               identity opts)
+             (try
+               (when analyze-path
+                 (analyze-source analyze-path opts))
+               (evaluate-form repl-env env "<cljs repl>"
+                 (with-meta
+                   '(ns cljs.user
+                      (:require [cljs.repl :refer-macros [doc]]))
+                   {:line 1 :column 1})
+                 identity opts)
+               (catch Throwable e
+                 (caught e repl-env opts)))
              (when-let [src (:watch opts)]
                (future
                  (let [log-file (io/file (util/output-directory opts) "watch.log")]
                    (print "Watch compilation log available at:" (str log-file))
-                   (binding [*out* (FileWriter. log-file)]
-                     (cljsc/watch src (dissoc opts :watch))))))
+                   (try
+                     (binding [*out* (FileWriter. log-file)]
+                       (cljsc/watch src (dissoc opts :watch)))
+                     (catch Throwable e
+                       (caught e repl-env opts))))))
              (binding [*in* (if (true? (:source-map-inline opts))
                               *in*
                               (reader))]
                (try
                  (init)
                  (catch Throwable e
-                   (caught e opts)))
+                   (caught e repl-env opts)))
+               ;; try to let things flush before printing prompt
                (prompt)
                (flush)
                (loop []
@@ -658,7 +668,7 @@
                    (try
                      (identical? (read-eval-print) request-exit)
                      (catch Throwable e
-                       (caught e opts)
+                       (caught e repl-env opts)
                        nil))
                    (when (need-prompt)
                      (prompt)
@@ -715,12 +725,13 @@
      - :print, function of one argument, prints its argument to the output
        default: println

-     - :caught, function of two arguments, a throwable, called when
-       read, eval, or print throws an exception or error
-       default. The second argument is opts, the standard ClojureScript
-       REPL/compiler options. In the case of errors or exception in the
-       JavaScript target, these will be thrown as clojure.lang.IExceptionInfo
-       instances.
+     - :caught, function of three arguments, a throwable, called when
+       read, eval, or print throws an exception or error default. The second
+       argument is the JavaScript evaluation environment this permits context
+       sensitive handling if necessary. The third argument is opts, the standard
+       ClojureScript REPL/compiler options. In the case of errors or exception
+       in the JavaScript target, these will be thrown as
+       clojure.lang.IExceptionInfo instances.
        default: repl-caught

      - :reader, the c.t.r reader to use.


Implement the :debug and :debug-body options

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -5,7 +5,7 @@
             [clj-http.multipart :as mp]
             [clj-http.util :refer [opt]]
             [clojure.pprint])
-  (:import (java.io FilterInputStream InputStream)
+  (:import (java.io ByteArrayOutputStream FilterInputStream InputStream)
            (java.net URI)
            (java.util Locale)
            (org.apache.http HttpEntity HeaderIterator HttpHost HttpRequest
@@ -135,7 +135,33 @@
             (proxy-super close))
           (finally
             (.close response)
-            (.shutdown conn-mgr)))))))
+            (when-not (conn/reusable? conn-mgr)
+              (.shutdown conn-mgr))))))))
+
+(defn- print-debug!
+  "Print out debugging information to *out* for a given request."
+  [{:keys [debug-body body] :as req} http-req]
+  (println "Request:" (type body))
+  (clojure.pprint/pprint
+   (assoc req
+          :body (if (opt req :debug-body)
+                  (cond
+                    (isa? (type body) String)
+                    body
+
+                    (isa? (type body) HttpEntity)
+                    (let [baos (ByteArrayOutputStream.)]
+                      (.writeTo ^HttpEntity body baos)
+                      (.toString baos "UTF-8"))
+
+                    :else nil)
+                  (if (isa? (type body) String)
+                    (format "... %s bytes ..."
+                            (count body))
+                    (and body (bean body))))
+          :body-type (type body)))
+  (println "HttpRequest:")
+  (clojure.pprint/pprint (bean http-req)))

 (defn request
   [{:keys [body
@@ -188,6 +214,7 @@
         (doseq [header-vth header-v]
           (.addHeader http-req header-n header-vth))
         (.addHeader http-req header-n (str header-v))))
+    (when (opt req :debug) (print-debug! req http-req))
     (let [^HttpResponse response (.execute client http-req context)
           ^HttpEntity entity (.getEntity response)
           status (.getStatusLine response)]


woops

woops

--- src/polismath/math/conversation.clj
+++ src/polismath/math/conversation.clj
@@ -217,8 +217,8 @@
                   (->> (mapv
                          (fn [rowname row]
                            [rowname (count (remove nil? row))])
-                         (nm/rownames rating-mat)
-                         (nm/get-matrix rating-mat))
+                         (nm/rownames raw-rating-mat)
+                         (nm/get-matrix raw-rating-mat))
                        (into {})))

    ;; Ugg... right, have to clarify that we don't want to drop this; are we leaving anything else out like this?


Refactor field change

Refactor field change

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -19,6 +19,9 @@
   (when (== (.-keyCode e) 13)
     (chsk-send! [:test/echo text])))

+(defn field-change [e owner text]
+  (om/set-state! owner :text (.. e -target -value)))
+
 (defn field-view [app owner]
   (reify
     om/IInitState
@@ -27,8 +30,7 @@
     om/IRenderState
     (render-state [this {:keys [text]}]
       (dom/input #js {:ref "data" :type "text" :value text
-                      :onChange #(om/set-state! owner :text
-                                                (.. % -target -value))
+                      :onChange #(field-change % owner text)
                       :onKeyPress #(send-field % text)}))))

 (defn data-view [app owner]


Combine lets and separate hover info from terrain info  with bullet

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -292,7 +292,8 @@
    (let [[sel-q sel-r] @(subs/selected-hex conn)
          [tar-q tar-r] @(subs/targeted-hex conn)
          [sel-mc sel-at sel-ar] @(subs/selected-terrain-effects conn)
-         [tar-mc tar-at tar-ar] @(subs/targeted-terrain-effects conn)]
+         [tar-mc tar-at tar-ar] @(subs/targeted-terrain-effects conn)
+         [hover-q hover-r] @(subs/hover-hex conn)]
      [:span
       (translate :selected-label)
       (if sel-q
@@ -316,13 +317,13 @@
          [:abbr {:title (translate :terrain-effects-label) :style {:cursor "inherit"}}
           (str tar-mc "," tar-at "," tar-ar)]
          ")"]
-        [:span " -"])])
-   (let [[hover-q hover-r] @(subs/hover-hex conn)]
-     [:span.hidden-xs.hidden-sm
-      (translate :hover-tile-location)
-      (if hover-q
-        (str hover-q "," hover-r)
-        "-")])])
+        [:span " -"])
+      " • "
+      [:span.hidden-xs.hidden-sm
+       (translate :hover-tile-location)
+       (if hover-q
+         (str hover-q "," hover-r)
+         "-")]])])

 (def armor-type-abbrevs
   {:unit-type.armor-type/personnel "P"


Address is actually 5 bits wide, since opcode is 3

Of course, this should be automatically calculated...

--- src/computer_build.clj
+++ src/computer_build.clj
@@ -150,7 +150,7 @@
             (:clock :in ~std-logic)
             (:data_in :in ~(std-logic-vector 7 0))
             (:data_out :out ~(std-logic-vector 7 0))
-            (:address :in ~(std-logic-vector 3 0))
+            (:address :in ~(std-logic-vector 4 0))
             (:wr_data :in ~std-logic)
             (:wr_addr :in ~std-logic)
             (:rd :in ~std-logic))
@@ -172,7 +172,7 @@
           (instance :reg "pc" :clock :system_bus :system_bus :wr_pc :rd_pc)   ; program counter
           (instance :reg "ir" :clock :system_bus :system_bus :wr_IR :rd_IR)   ; instruction register
           (instance :reg "A" :clock :system_bus :system_bus :wr_A :rd_A)      ; accumulator
-          (instance :ram "main_memory" :clock :system_bus :system_bus ~(subbits :system_bus 7 4) :wr_MD :wr_MA :rd_MD)
+          (instance :ram "main_memory" :clock :system_bus :system_bus ~(subbits :system_bus 4 0) :wr_MD :wr_MA :rd_MD)
           (instance :alu "alu0" :clock :system_bus :system_bus :alu_op :wr_alu_a :wr_alu_b :rd_alu)
           (instance :control_unit "control0" ~@(map first (concat control-in control-out)))
           (<= :bus_inspection :system_bus)


Extend function signature generation for Java interface

to incorporate additional type information.

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

--- src/conexp/contrib/java.clj
+++ src/conexp/contrib/java.clj
@@ -47,17 +47,24 @@
   gen-class."
   [new-name, ^clojure.lang.Var var]
   (let [arglists (:arglists (meta var)),
-        return   (or (:tag (meta var)) 'Object)]
+        return   (or (:tag (meta var)) 'Object),
+        tag      (fn [x]
+                   (let [tag (:tag (meta x))]
+                     (if-not tag
+                       'Object
+                       (case tag
+                         Lattice conexp.fca.lattices.Lattice
+                         Context conexp.fca.contexts.Context
+                         Association-Rule conexp.fca.association_rules.Association-Rule
+                         tag))))]
     (if-not arglists
       nil
       (for [arglist arglists]
         (let [arglist-split (dissect-arglist arglist)]
           [new-name
            (if (empty? (second arglist-split))
-             (vec (map (constantly 'Object)
-                       (first arglist-split)))
-             (conj (vec (map (constantly 'Object)
-                             (first arglist-split)))
+             (vec (map tag (first arglist-split)))
+             (conj (vec (map tag (first arglist-split)))
                    "[Ljava.lang.Object;"))
            return])))))


Run copycat from /root

Run copycat from /root

--- src/copycat_jepsen/core.clj
+++ src/copycat_jepsen/core.clj
@@ -77,8 +77,9 @@
     (meh (c/exec :truncate :--size 0 "/var/log/copycat.log"))
     (meh (c/exec :rm "/root/copycat*.log"))
     (c/su
-      (c/exec :java :-jar jarfile local-node-arg other-node-args
-              (c/lit "2>> /dev/null >> /var/log/copycat.log & echo $!")))))
+      (c/cd "/root"
+            (c/exec :java :-jar jarfile local-node-arg other-node-args
+                    (c/lit "2>> /dev/null >> /var/log/copycat.log & echo $!"))))))

 (defn stop!
   "Stops copycat."


Fix typo

Fix typo

--- src/datemo/routes.clj
+++ src/datemo/routes.clj
@@ -30,7 +30,7 @@
                     (catch Exception e (.getMessage e)))
         doc-html (tx->html doc-tx)]
     {:status 302
-     :headers {"Content-Type" "appl/uication/hal+json; charset=utf-8"}
+     :headers {"Content-Type" "application/hal+json; charset=utf-8"}
      :body {:_links {:self (apply str "/documents/" (str uuid-str))}
             :_embedded {:id uuid-str
                         :html doc-html}}}))


deleted outdated comment

deleted outdated comment

--- src/maqueta/application.clj
+++ src/maqueta/application.clj
@@ -92,6 +92,5 @@
           [control channel name]
           (if-let [callback (on-anim-cycle-done name)]
             (callback this control channel))))
-    ;; don't show settings dialog
     (.setShowSettings show-settings)
     (.setSettings *app-settings*)))


tweak to the previous fix

tweak to the previous fix

--- src/mavlink/mavlink_xml.clj
+++ src/mavlink/mavlink_xml.clj
@@ -189,13 +189,13 @@
                                                      (let [enum-name  (zip-xml/attr entry :name)
                                                            value (get-value (str "In " file-name " " enum-name " value")
                                                                             (zip-xml/attr entry :value))
-                                                           enum-value (long (if value value (inc last-value)))]
+                                                           enum-value (long (or value (inc last-value)))]
                                                        (recur enum-value
                                                               (first rest-entries)
                                                               (rest rest-entries)
-                                                              (merge values-map
-                                                                     {(keywordize enum-name)
-                                                                      enum-value})))))))))
+                                                              (assoc values-map
+                                                                     (keywordize enum-name)
+                                                                     enum-value)))))))))
        enums-by-group
         (apply merge (zip-xml/xml-> zipper :mavlink :enums :enum
                       (fn [e]


removed unused code

removed unused code

--- luminus/hello/src/hello/repl.clj
+++ luminus/hello/src/hello/repl.clj
@@ -1,34 +0,0 @@
-(ns hello.repl
-  (:use hello.handler
-        ring.server.standalone
-        [ring.middleware file-info file]))
-
-(defonce server (atom nil))
-
-(defn get-handler []
-  ;; #'app expands to (var app) so that when we reload our code,
-  ;; the server is forced to re-resolve the symbol in the var
-  ;; rather than having its own copy. When the root binding
-  ;; changes, the server picks it up without having to restart.
-  (-> #'app
-    ; Makes static assets in $PROJECT_DIR/resources/public/ available.
-    (wrap-file "resources")
-    ; Content-Type, Content-Length, and Last Modified headers for files in body
-    (wrap-file-info)))
-
-(defn start-server
-  "used for starting the server in development mode from REPL"
-  [& [port]]
-  (let [port (if port (Integer/parseInt port) 8080)]
-    (reset! server
-            (serve (get-handler)
-                   {:port port
-                    :init init
-                    :auto-reload? true
-                    :destroy destroy
-                    :join true}))
-    (println (str "You can view the site at http://localhost:" port))))
-
-(defn stop-server []
-  (.stop @server)
-  (reset! server nil))


Simple error message.

Simple error message.

--- src-cljs/main/githubcomments/core.cljs
+++ src-cljs/main/githubcomments/core.cljs
@@ -18,19 +18,21 @@
                    [:p.github-comment-author (:login user)]]))]
          [:div.github-comment-content (:body_html comment)]]))

-(defn display-comments [comments element]
-  (set! (.-innerHTML element)
-        (html [:ul (for [comment (take 10 comments)]
-                     (comment-to-li-tag comment))])))
+(defn comments-to-ul [comments]
+  (html [:ul
+         (for [comment (take 10 comments)] (comment-to-li-tag comment))]))
+
+(defn error-msg [response] (html [:p "Cannot display comments."]))

 (defn init []
   (go (let [element (dom/getElement "github-comments")
             repo [(dataset/get element "repositoryOwner")
                   (dataset/get element "repositoryName")]
             path (dataset/get element "path")
-            response (async/<! (repo-comments repo "html"))
-            relevant-comments (filter #(= (:path %1) path) (:body response))]
-        (prn response)
-        (display-comments relevant-comments element))))
+            response (async/<!  (repo-comments repo "html"))
+            relevant-comments (filter #(= (:path %1) path)(:body response))]
+        (set! (.-innerHTML element) (if (:success response)
+                                      (comments-to-ul relevant-comments)
+                                      (error-msg response))))))

 (init)


[#670] Uncomment debug code

[#670] Uncomment debug code

--- backend/src/akvo/lumen/admin/add_tenant.clj
+++ backend/src/akvo/lumen/admin/add_tenant.clj
@@ -282,7 +282,7 @@
   (try
     (check-env-vars)
     (let [{:keys [email label title url]} (conform-input url title email)]
-      #_(setup-database label title)
+      (setup-database label title)
       (let [user-creds (setup-tenant-in-keycloak label email url)]
         (println "Credentials:")
         (pprint user-creds)))


Prepend new sets to the top of the history list

--- src/app/cljs/one/repmax/sets/view.cljs
+++ src/app/cljs/one/repmax/sets/view.cljs
@@ -27,7 +27,7 @@
         set-list (css/sel "#recent-set-history ol")
         set-number (-> set-list (css/sel "li") d/nodes count inc)
         new-list-item (set-list-item (assoc exercise-set :number set-number))]
-    (d/append! set-list new-list-item)))
+    (d/prepend! set-list new-list-item)))

 (defn- set-list-item [exercise-set]
   (let [li (d/clone (:recent-set-history-list-item snippets))]


ignore budget monitor request when nil resource

--- src/clj/clj_money/web/money_shared.clj
+++ src/clj/clj_money/web/money_shared.clj
@@ -93,7 +93,7 @@
   (let [entity (if (map? entity-or-id)
                  entity-or-id
                  (entities/find-by-id (env :db) entity-or-id))]
-    (when (allowed? :show entity)
+    (when (and entity (allowed? :show entity))
       (html
         [:h3 "Budget monitors"]
         (->> (-> entity


refactor evidence

refactor evidence

--- src/cljs/salava/badge/ui/evidence.cljs
+++ src/cljs/salava/badge/ui/evidence.cljs
@@ -81,12 +81,20 @@
         {:keys [resource_type mime_type resource_id]} properties
         badge-id (:id data)]
     (swap! state assoc :evidence {:message nil}
-                       :input_mode nil)
+           ;:input_mode nil
+           )
     (if (and (not (blank? narrative)) (blank? name))
       (swap! state assoc :evidence {:message [:div.alert.alert-warning [:p (t :badge/Emptynamefield)]]
                                     :name name
                                     :narrative narrative
-                                    :url url})
+                                    :url url
+                                    :properties {:mime_type mime_type
+                                                 :resource_id resource_id
+                                                 :resource_type (case @(cursor state [:input_mode])
+                                                                  :page_input "page"
+                                                                  :file_input "file"
+                                                                  :url "url")}
+                                    :resource_visibility resource_visibility})
       (do
         (if (= "private" resource_visibility) (set-page-visibility-to-private resource_id))
         (ajax/POST


small fix

small fix

--- src/cljs/salava/badge/ui/settings.cljs
+++ src/cljs/salava/badge/ui/settings.cljs
@@ -260,7 +260,6 @@

         ;;Preview
         (when @(cursor state [:show-preview])
-         [:div.row
           [:div.preview.evidence-list.col-md-9
            [:div.panel.panel-default
             [:div.panel-heading
@@ -289,11 +288,11 @@
                  [:div.col-md-9
                   [evidence/input {:name "narrative" :rows 5 :cols 40 :atom evidence-narrative-atom } true]]]])

-             ]]]])
+             ]]])

         ;;url input
-        (when (= @input-mode :url_input) [:div.row.flip
-                                          [:div.col-md-9
+        (when (= @input-mode :url_input) [:div
+                                          [:div.col-md-12
                                            [:div.resource-container {:style {:margin-bottom "10px"}}
                                             [evidence/input {:name "evidence-url" :atom evidence-url-atom :type "url" :placeholder "http://" :preview? (cursor state [:show-preview])}]]]])
         ;;Resource grid


Use environment variable

Use environment variable

--- src/clj/chili_dog_night/core.clj
+++ src/clj/chili_dog_night/core.clj
@@ -19,7 +19,7 @@
   (:gen-class))

 (def ^:dynamic *rss-feed-item-limit* 20)
-(def ^:dynamic *auth-data* {:admin "secret"})
+(def ^:dynamic *auth-data* {:admin (System/getenv "CHILI_DOG_NIGHT_ADMIN_PASSWORD")})
 (def ^:dynamic db-spec (System/getenv "DATABASE_URL"))

 (defn basic-auth [req {:keys [username password]}]


Allow startup in a non-user ns

Allow startup in a non-user ns

refs technomancy/leiningen#955

--- src/clj/reply/initialization.clj
+++ src/clj/reply/initialization.clj
@@ -105,43 +105,44 @@
     (use '[clojure.java.javadoc :only ~'[javadoc]])
     (use '[clojure.pprint :only ~'[pp pprint]])

-    ~(export-definition 'reply.initialization/help)
+    (let [original-ns# ~'*ns*]
+      (ns reply.exports)
+      ~(export-definition 'reply.initialization/intern-with-meta)

-    (ns reply.exports)
-    ~(export-definition 'reply.initialization/intern-with-meta)
+      (binding [*err* (java.io.StringWriter.)]
+        ~(export-definition 'reply.initialization/repl-defn)
+        (~'intern-with-meta '~'user '~'defn ~'#'repl-defn))

-    (binding [*err* (java.io.StringWriter.)]
-      ~(export-definition 'reply.initialization/repl-defn)
-      (~'intern-with-meta '~'user '~'defn ~'#'repl-defn))
+      ~(export-definition 'reply.initialization/help)
+      (~'intern-with-meta '~'user '~'help ~'#'help)

-    ~(export-definition 'reply.initialization/sourcery)
-    (~'intern-with-meta '~'user '~'sourcery ~'#'sourcery)
+      ~(export-definition 'reply.initialization/sourcery)
+      (~'intern-with-meta '~'user '~'sourcery ~'#'sourcery)

-    ~(export-definition 'reply.initialization/clojuredocs-available?)
-    ~(export-definition 'reply.initialization/call-with-ns-and-name)
-    ~(export-definition 'reply.initialization/handle-fns-etc)
-    ~(export-definition 'reply.initialization/lazy-clojuredocs)
-    (~'intern-with-meta '~'user '~'clojuredocs ~'#'lazy-clojuredocs)
-    (~'intern-with-meta '~'user '~'cdoc ~'#'lazy-clojuredocs)
+      ~(export-definition 'reply.initialization/clojuredocs-available?)
+      ~(export-definition 'reply.initialization/call-with-ns-and-name)
+      ~(export-definition 'reply.initialization/handle-fns-etc)
+      ~(export-definition 'reply.initialization/lazy-clojuredocs)
+      (~'intern-with-meta '~'user '~'clojuredocs ~'#'lazy-clojuredocs)
+      (~'intern-with-meta '~'user '~'cdoc ~'#'lazy-clojuredocs)

-    (try
-      (require '[complete.core])
-      ; hack for 1.2 support until we release the next clojure-complete version
-      ~(export-definition 'reply.initialization/resolve-class)
-      (~'intern-with-meta '~'complete.core '~'resolve-class ~'#'resolve-class)
+      (try
+        (require '[complete.core])
+        ; hack for 1.2 support until we release the next clojure-complete version
+        ~(export-definition 'reply.initialization/resolve-class)
+        (~'intern-with-meta '~'complete.core '~'resolve-class ~'#'resolve-class)

-      (catch Exception e#
-        (try
-          (eval '~(formify-file
-                  (ClassLoader/getSystemResource "complete/core.clj")))
-          (catch Exception f#
-            (intern (create-ns '~'complete.core) '~'completions
-              (fn [prefix# ns#] []))
-            (println "Unable to initialize completions.")))))
+        (catch Exception e#
+          (try
+            (eval '~(formify-file
+                      (ClassLoader/getSystemResource "complete/core.clj")))
+            (catch Exception f#
+              (intern (create-ns '~'complete.core) '~'completions
+                      (fn [prefix# ns#] []))
+              (println "Unable to initialize completions.")))))

-    (in-ns '~'user)
-
-    (~'help)
+      (in-ns (ns-name original-ns#)))
+    (~'user/help)
     nil))

 (defn eval-in-user-ns [code]