Naively import Clojure defrecord implementation.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -4,12 +4,340 @@
    [(:require
      [active.clojure.lens :as lens]
      [active.clojure.condition :as c]
-     [active.clojure.macro :refer [if-cljs]])]
+     [active.clojure.macro :refer [if-cljs]])
+    (:import clojure.lang.IPersistentMap)
+    (:import clojure.lang.RT)
+    (:import java.lang.IllegalArgumentException)
+    ]
    :cljs
    [(:require
      [active.clojure.lens :as lens]
      [active.clojure.condition :as c])
     (:require-macros [active.clojure.macro :refer [if-cljs]])]))
+
+(defn ^{:private true}
+  maybe-destructured
+  [params body]
+  (if (every? symbol? params)
+    (cons params body)
+    (loop [params params
+           new-params (with-meta [] (meta params))
+           lets []]
+      (if params
+        (if (symbol? (first params))
+          (recur (next params) (conj new-params (first params)) lets)
+          (let [gparam (gensym "p__")]
+            (recur (next params) (conj new-params gparam)
+                   (-> lets (conj (first params)) (conj gparam)))))
+        `(~new-params
+          (let ~lets
+            ~@body))))))
+
+(defn- parse-opts [s]
+  (loop [opts {} [k v & rs :as s] s]
+    (if (keyword? k)
+      (recur (assoc opts k v) rs)
+      [opts s])))
+
+(defn- parse-impls [specs]
+  (loop [ret {} s specs]
+    (if (seq s)
+      (recur (assoc ret (first s) (take-while seq? (next s)))
+             (drop-while seq? (next s)))
+      ret)))
+
+(defn- parse-opts+specs [opts+specs]
+  (let [[opts specs] (parse-opts opts+specs)
+        impls (parse-impls specs)
+        interfaces (-> (map #(if (var? (resolve %))
+                               (:on (deref (resolve %)))
+                               %)
+                            (keys impls))
+                       set
+                       (disj 'Object 'java.lang.Object)
+                       vec)
+        methods (map (fn [[name params & body]]
+                       (cons name (maybe-destructured params body)))
+                     (apply concat (vals impls)))]
+    (when-let [bad-opts (seq (remove #{:no-print :load-ns} (keys opts)))]
+      (let [^String msg (apply print-str "Unsupported option(s) -" bad-opts)]
+        (throw (IllegalArgumentException. msg))))
+    [interfaces methods opts]))
+
+(defn- imap-cons
+  [^IPersistentMap this o]
+  (cond
+   (map-entry? o)
+     (let [^java.util.Map$Entry pair o]
+       (.assoc this (.getKey pair) (.getValue pair)))
+   (instance? clojure.lang.IPersistentVector o)
+     (let [^clojure.lang.IPersistentVector vec o]
+       (.assoc this (.nth vec 0) (.nth vec 1)))
+   :else (loop [this this
+                o o]
+      (if (seq o)
+        (let [^java.util.Map$Entry pair (first o)]
+          (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o)))
+        this))))
+
+(defn- emit-defrecord
+  "Do not use this directly - use defrecord"
+  {:added "1.2"}
+  [tagname cname fields interfaces methods opts]
+  (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." cname)) (meta cname))
+        interfaces (vec interfaces)
+        interface-set (set (map resolve interfaces))
+        methodname-set (set (map first methods))
+        hinted-fields fields
+        fields (vec (map #(with-meta % nil) fields))
+        base-fields fields
+        fields (conj fields '__meta '__extmap
+                     '^:unsynchronized-mutable __hash
+                     '^:unsynchronized-mutable __hasheq)
+        type-hash (hash classname)]
+    (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields))
+      (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
+    (let [gs (gensym)]
+    (letfn
+     [(irecord [[i m]]
+        [(conj i 'clojure.lang.IRecord)
+         m])
+      (eqhash [[i m]]
+        [(conj i 'clojure.lang.IHashEq)
+         (conj m
+               `(hasheq [this#] (let [hq# ~'__hasheq]
+                                  (if (zero? hq#)
+                                    (let [h# (int (bit-xor ~type-hash (clojure.lang.APersistentMap/mapHasheq this#)))]
+                                      (set! ~'__hasheq h#)
+                                      h#)
+                                    hq#)))
+               `(hashCode [this#] (let [hash# ~'__hash]
+                                    (if (zero? hash#)
+                                      (let [h# (clojure.lang.APersistentMap/mapHash this#)]
+                                        (set! ~'__hash h#)
+                                        h#)
+                                      hash#)))
+               `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))])
+      (iobj [[i m]]
+            [(conj i 'clojure.lang.IObj)
+             (conj m `(meta [this#] ~'__meta)
+                   `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))])
+      (ilookup [[i m]]
+         [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
+          (conj m `(valAt [this# k#] (.valAt this# k# nil))
+                `(valAt [this# k# else#]
+                   (case k# ~@(mapcat (fn [fld] [(keyword fld) fld])
+                                       base-fields)
+                         (get ~'__extmap k# else#)))
+                `(getLookupThunk [this# k#]
+                   (let [~'gclass (class this#)]
+                     (case k#
+                           ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})]
+                               (mapcat
+                                (fn [fld]
+                                  [(keyword fld)
+                                   `(reify clojure.lang.ILookupThunk
+                                           (get [~'thunk ~'gtarget]
+                                                (if (identical? (class ~'gtarget) ~'gclass)
+                                                  (. ~hinted-target ~(symbol (str "-" fld)))
+                                                  ~'thunk)))])
+                                base-fields))
+                           nil))))])
+      (imap [[i m]]
+            [(conj i 'clojure.lang.IPersistentMap)
+             (conj m
+                   `(count [this#] (+ ~(count base-fields) (count ~'__extmap)))
+                   `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
+                   `(cons [this# e#] ((var imap-cons) this# e#))
+                   `(equiv [this# ~gs]
+                        (boolean
+                         (or (identical? this# ~gs)
+                             (when (identical? (class this#) (class ~gs))
+                               (let [~gs ~(with-meta gs {:tag tagname})]
+                                 (and  ~@(map (fn [fld] `(= ~fld (. ~gs ~(symbol (str "-" fld))))) base-fields)
+                                       (= ~'__extmap (. ~gs ~'__extmap))))))))
+                   `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#))))
+                   `(entryAt [this# k#] (let [v# (.valAt this# k# this#)]
+                                            (when-not (identical? this# v#)
+                                              (clojure.lang.MapEntry/create k# v#))))
+                   `(seq [this#] (seq (concat [~@(map #(list `clojure.lang.MapEntry/create (keyword %) %) base-fields)]
+                                              ~'__extmap)))
+                   `(iterator [~gs]
+                        (clojure.lang.RecordIterator. ~gs [~@(map keyword base-fields)] (RT/iter ~'__extmap)))
+                   `(assoc [this# k# ~gs]
+                     (condp identical? k#
+                       ~@(mapcat (fn [fld]
+                                   [(keyword fld) (list* `new tagname (replace {fld gs} (remove '#{__hash __hasheq} fields)))])
+                                 base-fields)
+                       (new ~tagname ~@(remove '#{__extmap __hash __hasheq} fields) (assoc ~'__extmap k# ~gs))))
+                   `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
+                                            (dissoc (with-meta (into {} this#) ~'__meta) k#)
+                                            (new ~tagname ~@(remove '#{__extmap __hash __hasheq} fields)
+                                                 (not-empty (dissoc ~'__extmap k#))))))])
+      (ijavamap [[i m]]
+                [(conj i 'java.util.Map 'java.io.Serializable)
+                 (conj m
+                       `(size [this#] (.count this#))
+                       `(isEmpty [this#] (= 0 (.count this#)))
+                       `(containsValue [this# v#] (boolean (some #{v#} (vals this#))))
+                       `(get [this# k#] (.valAt this# k#))
+                       `(put [this# k# v#] (throw (UnsupportedOperationException.)))
+                       `(remove [this# k#] (throw (UnsupportedOperationException.)))
+                       `(putAll [this# m#] (throw (UnsupportedOperationException.)))
+                       `(clear [this#] (throw (UnsupportedOperationException.)))
+                       `(keySet [this#] (set (keys this#)))
+                       `(values [this#] (vals this#))
+                       `(entrySet [this#] (set this#)))])
+      ]
+     (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)]
+       `(deftype* ~(symbol (name (ns-name *ns*)) (name tagname)) ~classname
+          ~(conj hinted-fields '__meta '__extmap
+                 '^int ^:unsynchronized-mutable __hash
+                 '^int ^:unsynchronized-mutable __hasheq)
+          :implements ~(vec i)
+          ~@(mapcat identity opts)
+          ~@m))))))
+
+(defn- build-positional-factory
+  "Used to build a positional factory for a given type/record.  Because of the
+  limitation of 20 arguments to Clojure functions, this factory needs to be
+  constructed to deal with more arguments.  It does this by building a straight
+  forward type/record ctor call in the <=20 case, and a call to the same
+  ctor pulling the extra args out of the & overage parameter.  Finally, the
+  arity is constrained to the number of expected fields and an ArityException
+  will be thrown at runtime if the actual arg count does not match."
+  [nom classname fields]
+  (let [fn-name (symbol (str '-> nom))
+        [field-args over] (split-at 20 fields)
+        field-count (count fields)
+        arg-count (count field-args)
+        over-count (count over)
+        docstring (str "Positional factory function for class " classname ".")]
+    `(defn ~fn-name
+       ~docstring
+       [~@field-args ~@(if (seq over) '[& overage] [])]
+       ~(if (seq over)
+          `(if (= (count ~'overage) ~over-count)
+             (new ~classname
+                  ~@field-args
+                  ~@(for [i (range 0 (count over))]
+                      (list `nth 'overage i)))
+             (throw (clojure.lang.ArityException. (+ ~arg-count (count ~'overage)) (name '~fn-name))))
+          `(new ~classname ~@field-args)))))
+
+(defn- validate-fields
+  ""
+  [fields name]
+  (when-not (vector? fields)
+    (throw (AssertionError. "No fields vector given.")))
+  (let [specials '#{__meta __hash __hasheq __extmap}]
+    (when (some specials fields)
+      (throw (AssertionError. (str "The names in " specials " cannot be used as field names for types or records.")))))
+  (let [non-syms (remove symbol? fields)]
+    (when (seq non-syms)
+      (throw (clojure.lang.Compiler$CompilerException.
+              *file*
+              (.deref clojure.lang.Compiler/LINE)
+              (.deref clojure.lang.Compiler/COLUMN)
+              (AssertionError.
+               (str "defrecord and deftype fields must be symbols, "
+                    *ns* "." name " had: "
+                    (apply str (interpose ", " non-syms)))))))))
+
+(defmacro active-defrecord
+  "(defrecord name [fields*]  options* specs*)
+
+  Options are expressed as sequential keywords and arguments (in any order).
+
+  Supported options:
+  :load-ns - if true, importing the record class will cause the
+             namespace in which the record was defined to be loaded.
+             Defaults to false.
+
+  Each spec consists of a protocol or interface name followed by zero
+  or more method bodies:
+
+  protocol-or-interface-or-Object
+  (methodName [args*] body)*
+
+  Dynamically generates compiled bytecode for class with the given
+  name, in a package with the same name as the current namespace, the
+  given fields, and, optionally, methods for protocols and/or
+  interfaces.
+
+  The class will have the (immutable) fields named by
+  fields, which can have type hints. Protocols/interfaces and methods
+  are optional. The only methods that can be supplied are those
+  declared in the protocols/interfaces.  Note that method bodies are
+  not closures, the local environment includes only the named fields,
+  and those fields can be accessed directly.
+
+  Method definitions take the form:
+
+  (methodname [args*] body)
+
+  The argument and return types can be hinted on the arg and
+  methodname symbols. If not supplied, they will be inferred, so type
+  hints should be reserved for disambiguation.
+
+  Methods should be supplied for all methods of the desired
+  protocol(s) and interface(s). You can also define overrides for
+  methods of Object. Note that a parameter must be supplied to
+  correspond to the target object ('this' in Java parlance). Thus
+  methods for interfaces will take one more argument than do the
+  interface declarations. Note also that recur calls to the method
+  head should *not* pass the target object, it will be supplied
+  automatically and can not be substituted.
+
+  In the method bodies, the (unqualified) name can be used to name the
+  class (for calls to new, instance? etc).
+
+  The class will have implementations of several (clojure.lang)
+  interfaces generated automatically: IObj (metadata support) and
+  IPersistentMap, and all of their superinterfaces.
+
+  In addition, defrecord will define type-and-value-based =,
+  and will defined Java .hashCode and .equals consistent with the
+  contract for java.util.Map.
+
+  When AOT compiling, generates compiled bytecode for a class with the
+  given name (a symbol), prepends the current ns as the package, and
+  writes the .class file to the *compile-path* directory.
+
+  Two constructors will be defined, one taking the designated fields
+  followed by a metadata map (nil for none) and an extension field
+  map (nil for none), and one taking only the fields (using nil for
+  meta and extension fields). Note that the field names __meta,
+  __extmap, __hash and __hasheq are currently reserved and should not
+  be used when defining your own records.
+
+  Given (defrecord TypeName ...), two factory functions will be
+  defined: ->TypeName, taking positional parameters for the fields,
+  and map->TypeName, taking a map of keywords to field values."
+  {:added "1.2"
+   :arglists '([name [& fields] & opts+specs])}
+
+  [name fields & opts+specs]
+  (validate-fields fields name)
+  (let [gname name
+        [interfaces methods opts] (parse-opts+specs opts+specs)
+        ns-part (namespace-munge *ns*)
+        classname (symbol (str ns-part "." gname))
+        hinted-fields fields
+        fields (vec (map #(with-meta % nil) fields))]
+    `(let []
+       (declare ~(symbol (str  '-> gname)))
+       (declare ~(symbol (str 'map-> gname)))
+       ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods opts)
+       (import ~classname)
+       ~(build-positional-factory gname classname fields)
+       (defn ~(symbol (str 'map-> gname))
+         ~(str "Factory function for class " classname ", taking a map of keywords to field values.")
+         ([m#] (~(symbol (str classname "/create"))
+                (if (instance? clojure.lang.MapEquivalence m#) m# (into {} m#)))))
+       ~classname)))
+
+

 (defn throw-illegal-argument-exception
   [msg]
@@ -129,7 +457,7 @@
           (throw (throw-illegal-argument-exception (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))

     `(do
-       (defrecord ~?type
+       (active-defrecord ~?type
            [~@(map first ?field-triples)]
          ~@?opt+specs)


This solution passes HOH test but fails HOHOHO test :) :) :) So, there is problem in iterator and processor functions. Basic stub is OK though.

--- src/adventofcode/solutions.clj
+++ src/adventofcode/solutions.clj
@@ -784,24 +784,35 @@

 ;day 19
 (defn ^{:private true} d19-processor [s f t]
-  (let [where (.indexOf s f)
-        so-far (+ where (count f))]
+  (let [where (.indexOf s f)]
     (when (>= where 0)
-      (let [remainder (subs s so-far)]
+      (let [remainder (subs s (inc where))]
         [where (str (subs s 0 where) t remainder) remainder]))))

-(defn day19 []
+(defn ^{:private true} d19-input-iterator-maker
+  [src from to]
+  (fn [[_ _ ns]]
+    (when-let [[w rep remainder] (d19-processor ns from to)]
+      (let [src-len (count src)
+            rep-len (count rep)
+            pos-in-src (- src-len rep-len)]
+        [(+ w pos-in-src) (str (subs src 0 w) rep) remainder]))))
+
+(defn ^{:private true} d19-replacements
+  [from to src first-input]
+  (reduce (fn [a v]
+            (if v
+              (conj a (second v))
+              (reduced a))) #{} (iterate (d19-input-iterator-maker src from to) first-input)))
+
+(defn day19
+  []
   (let [input (day-input-line-seq 19)
         size (count input)
         replacements (map #(let [[_ from to] (first (re-seq #"(\w+) => (\w+)" %))]
                             [from to]) (take (- size 2) input))
-        src (last input)
-        [from to] (first replacements)
-        first-input (d19-processor src from to)]
-    (reduce (fn [a v]
-              (if v
-                (conj a (second v))
-                (reduced a))) #{} (iterate (fn [x]
-                                             (let [[_ _ ns] x]
-                                               (when-let [[w rep remainder] (d19-processor ns from to)]
-                                                 [w (str (subs src 0 w) rep) remainder]))) first-input))))+        src (last input)]
+    (reduce (fn [a [from to]]
+              (let [first-input (d19-processor src from to)]
+                (into a
+                      (d19-replacements from to src first-input)))) #{} replacements)))


scheduled functions part2

scheduled functions part2

--- src/sandbox/multithread.clj
+++ src/sandbox/multithread.clj
@@ -272,3 +272,70 @@
   (reduce merge (map prepare-locks-for-a-p processes)))
 ;;=> Applying "prepare-locks-for-a-p", we generate locks for all
 ;;   processes  that would run concurrently.
+
+(defn gen-processes-cycles
+  [processes]
+  (let [sorted-procs-by-prio (sort-by :priority > processes)
+        procs-pattern (mapcat #(repeat (:priority %)
+                                       %)
+                              sorted-procs-by-prio)]
+    ;;=> A pattern is a single repetition "priority" times of each
+    ;;   process
+    (cycle procs-pattern)))
+;;=> Generates an infinite sequence like we described above.
+
+(defn process-sequential-time
+  [a-process]
+  (let [instructions (a-process :instructions)
+        inst-types (map :inst-type instructions)
+        lengths (map #(get insts-effort %) inst-types)]
+    (reduce + lengths)))
+;;=> We get instruction-types, grab the efforts from the "insts-
+;; effort"
+;;   map and sum them all up using reduce.
+
+(defn schedule-programs
+  [language programs]
+;;=> programs are maps : {:program "the textual program",
+;;  :process-id the-process-id
+;;  :priority the-process-priority }
+  (let [processes (into [] (map #(fire-a-process language
+                                                 (:program %)
+                                                 (:process-id %)
+                                                 (:priority %))
+                                programs))
+;;=> Processes are constructed
+        timeout (* 2 (reduce + (map process-sequential-time
+                                    processes)))
+;;=> "timeout" is the total length of all processes executed one
+;;   after the other.
+        locks (ref (prepare-locks processes))
+        scheduled (ref (prepare-scheduled processes))
+        processes-cycles  (gen-processes-cycles processes)]
+;;=> We prepare "locks" and "scheduled" refs, and the weighted
+;;   process repetitions that the scheduler will have to cycle
+;;   through
+    (loop [quantum 0
+           remaining-processes processes-cycles]
+;;=> We loop
+      (if (and (more-incomplete-processes? (scheduled-processes-parts @scheduled))
+               (< quantum timeout))
+        (do
+          (progress-on-process! locks scheduled
+                                (first remaining-processes)
+                                quantum)
+;;=> progress on the selected process, with current "quantum"
+          (recur (inc quantum)
+                 (next remaining-processes)))
+;;=> Go to next iteration, incrementing quantum and cycling
+;;=> through the The weighted processes cycles.
+        @scheduled))))
+
+(def programs
+  [{:priority 3,
+    :program
+    "heavy-op op1;light-op op2;lock l1;medium-op op3;unlock l1;",
+    :process-id :pr1}
+   {:priority 1,
+    :program "lock l1;medium-op op4;unlock l1;medium-op op5;",
+    :process-id :pr2}])


map -> mapv

map -> mapv

--- src/sandbox/multithread.clj
+++ src/sandbox/multithread.clj
@@ -62,13 +62,12 @@
        (filter #(= (:inst-type %) :lock))
        (map #(hash-map :lock-id (% :inst-id) :lock-idx (.indexOf instructions %)))))

-(defn the-locks-inst-depends-on
+(defn locks-inst-depends-on
   [instructions instruction]
-  (let [the-inst-idx (.indexOf instructions instruction)]
+  (let [inst-idx (.indexOf instructions instruction)]
     (->> (all-lock-indices instructions)
-         (filter #(> the-inst-idx (:lock-idx %) ))
-         (map :lock-id)
-         (into []))))
+         (filter #(> inst-idx (:lock-idx %) ))
+         (mapv :lock-id))))

 (defn lock [locks process-id lock-id]
   (assoc locks lock-id {:locker process-id :locked true}))
@@ -77,7 +76,7 @@
   (assoc locks lock-id {:locker process-id :locked false}))

 (defn is-locked? [process-id instructions locks instruction]
-  (->> (the-locks-inst-depends-on instructions instruction)
+  (->> (locks-inst-depends-on instructions instruction)
        (some #(and (not= process-id ((get locks %) :locker))
                    ((get locks %) :locked)))))

@@ -154,10 +153,10 @@

 (defn add-times [instructions]
-  (vec (map #(assoc % :times []) instructions)))
+  (mapv #(assoc % :times []) instructions))

 (defn prepare-scheduled [processes]
-  (vec (map #(update % :instructions add-times) processes)))
+  (mapv #(update % :instructions add-times) processes))

 (defn prepare-locks [processes]
   (->> (ps->is processes)
@@ -178,11 +177,11 @@
        (* 2)))

 (defn parse-processes [language programs]
-  (vec (map #(fire-process language
+  (mapv #(fire-process language
                              (:program %)
                              (:process-id %)
                              (:priority %))
-            programs)))
+            programs))

 (defn schedule-programs [language programs]
   (let [processes (parse-processes language programs)
@@ -192,7 +191,7 @@
         processes-cycles  (gen-processes-cycles processes)]
     (loop [quantum 0
            remaining-processes processes-cycles]
-      (if (and (more-incomplete-processes? (scheduled-processes-parts @scheduled))
+      (if (and (more-incomplete-processes? @scheduled)
                (< quantum timeout))
         (do
           (progress-on-process! locks scheduled


(PDB-3043) Fix admin-cleanup-test race condition

Travis seems to be particularly good at exposing this test race
condition. The symptom is a noisy but passing
`puppetlabs.puppetdb.admin-clean-test/admin-clean-competition`. The test
finishes, but the database connection pool is shutdown before
the cleanup finishes. This then causes the next test
`puppetlabs.puppetdb.admin-clean-test/admin-clean-status` to fail.

--- test/puppetlabs/puppetdb/admin_clean_test.clj
+++ test/puppetlabs/puppetdb/admin_clean_test.clj
@@ -66,17 +66,22 @@
     (let [pdb (get-service *server* :PuppetDBServer)
           orig-clean cli-svc/clean-up
           in-clean (CyclicBarrier. 2)
-          test-finished (CyclicBarrier. 2)]
+          test-finished (CyclicBarrier. 2)
+          cleanup-result (promise)]
       (with-redefs [cli-svc/clean-up (fn [& args]
                                        (.await in-clean)
                                        (.await test-finished)
-                                       (apply orig-clean args))]
+                                       (let [result (apply orig-clean args)]
+                                            (deliver cleanup-result result)
+                                            result))]
         (utils/noisy-future (checked-admin-post "cmd" (clean-cmd [])))
         (try
           (.await in-clean)
           (is (= http/status-conflict (:status (post-clean []))))
           (finally
-            (.await test-finished)))))))
+            (.await test-finished)
+            (is (not= ::timed-out
+                      (deref cleanup-result 10000 ::timed-out)))))))))

 (defn- clean-status []
   (gauges/value (:cleaning cli-svc/admin-metrics)))


PCP-147 Add missing process-server-message unit test

--- test/unit/puppetlabs/pcp/broker/core_test.clj
+++ test/unit/puppetlabs/pcp/broker/core_test.clj
@@ -288,6 +288,18 @@
       (process-inventory-message broker capsule connection)
       (is (= [] (:uris (message/get-json-data (:message @accepted))))))))

+(deftest process-server-message-test
+  (let [broker (make-test-broker)
+        message (message/make-message :message_type "http://puppetlabs.com/associate_request")
+        capsule (capsule/wrap message)
+        connection (connection/make-connection "ws1")
+        associate-request (atom nil)]
+    (with-redefs [puppetlabs.pcp.broker.core/process-associate-message (fn [broker capsule connection]
+                                                                         (reset! associate-request capsule)
+                                                                         connection)]
+      (process-server-message broker capsule connection)
+      (is (not= nil @associate-request)))))
+
 (deftest validate-certname-test
   (testing "simple match, no exception"
     (is (validate-certname "pcp://lolcathost/agent" "lolcathost")))


Update lein profiles

Update lein profiles

--- dotfiles/lein/profiles.clj
+++ dotfiles/lein/profiles.clj
@@ -3,22 +3,27 @@
     :plugins [
       [lein-ancient "0.6.15"]
       [lein-bikeshed "0.5.1"]
-      [lein-cljfmt "0.6.1"]
+      [lein-cljfmt "0.6.3"]
       [lein-gen "0.2.2"]
       [lein-kibit "0.1.6"]
       [lein-pprint "1.2.0"]
       [com.jakemccrary/lein-test-refresh "0.23.0"]
       [cider/cider-nrepl "0.18.0"]
-      [jonase/eastwood "0.2.9"]
-      [venantius/ultra "0.5.2"]
-      [venantius/yagni "0.1.6"]
+      [jonase/eastwood "0.3.4"]
+      ; [venantius/ultra "0.5.2"]
+      [venantius/yagni "0.1.7"]
     ]
     :dependencies [
-      [cljfmt "0.6.1"]
-      [cider/piggieback "0.3.9"]
+      [cljfmt "0.6.3"]
+      [cider/piggieback "0.3.10"]
       [org.clojure/tools.nrepl "0.2.13"]
-      [jonase/eastwood "0.2.9"
+      [jonase/eastwood "0.3.4"
        :exclusions [org.clojure/clojure]]
+    ]
+    :middleware [
+      cider-nrepl.plugin/middleware
+      lein-gen.plugin/middleware
+      ; ultra.plugin/middleware
     ]
     :repl-options {
       :prompt (fn [ns] (str "[" ns "](\u001b[36mλ\u001b[0m)> "))


only add comment if fields are not empty

--- src/my_todo/core.cljs
+++ src/my_todo/core.cljs
@@ -18,15 +18,14 @@
       {:author "aut2" :text "text2"}
       {:author "aut3" :text "text3"}] }))

-;;event handler
+;;event handlers

 (defn add-comment [evt owner {:keys [author text add] :as data}]
   (.preventDefault evt)
-  (println (keys data))
-  (println (str author text))
-  (om/set-state! owner :author "")
-  (om/set-state! owner :text "")
-  (put! add {:author author :text text} ))
+  (when-not (or (empty? author) (empty? text))
+    (om/set-state! owner :author "")
+    (om/set-state! owner :text "")
+    (put! add {:author author :text text} )))

 ;;(defn handle-change [e owner {:keys [text]}]
 (defn handle-change [e owner key-name]
@@ -69,9 +68,9 @@

 ;;main component

-(defn render-comment-list [data]
+(defn render-comment-list [{:keys [comments]}]
   (apply dom/ul #js {:className "commentList"}
-    (om/build-all comment-view (:comments data))))
+    (om/build-all comment-view comments)))

 (defn comment-box [data owner]
   (reify
@@ -84,7 +83,6 @@
       (let [add (om/get-state owner :add)]
         (go (loop []
           (let [new-comment (<! add)]
-            (println new-comment)
             (om/transact! data :comments #(conj % new-comment))
             (recur))))))


pull in scope as part of overtone.live

pull in scope as part of overtone.live

--- src/overtone/live.clj
+++ src/overtone/live.clj
@@ -8,7 +8,8 @@
              trigger buffer envelope bus sample sc-lang]
             [overtone.music rhythm pitch tuning]
             [overtone.studio core util fx]
-            [overtone.console viz]))
+            [overtone.console viz]
+            [overtone.viz scope]))

 (immigrate
   'osc
@@ -34,7 +35,8 @@
   'overtone.studio.core
   'overtone.studio.fx
   'overtone.console.viz
-  )
+  'overtone.viz.scope
+ )

 (defonce _auto-boot_ (boot))


Rephrase promisify docstring

Rephrase promisify docstring

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -477,9 +477,9 @@
 ;; Utils

 (defn promisify
-  "Given a nodejs like function that accepts a callback
-  as the last argument and return an other function
-  that returns a promise."
+  "Given a function that accepts a callback as the last argument return other
+  function that returns a promise. Callback is expected to take single
+  parameter (result of a computation)."
   [callable]
   (fn [& args]
     (promise (fn [resolve reject]


db collection rename

db collection rename

--- src/spcr/mongodal.clj
+++ src/spcr/mongodal.clj
@@ -4,7 +4,7 @@
   (:import [com.mongodb MongoOptions ServerAddress]))

-(def collection-name "raw-data")
+(def collection-name "rawdata")

 (defn db-save [db data]
   (mc/insert-batch


fixed eval-with-map to use values from memory, rather than re-evaling everything

--- src/stencil/utils.clj
+++ src/stencil/utils.clj
@@ -27,14 +27,16 @@
       ;; unsuccessful in finding the key.
       nil)))

-(defn symbolize-keys
-  [[k v]]
-  (list (symbol (name k)) v))
+(declare ^:dynamic *locals*)

 (defn eval-with-map
-  [bindings form]
-  (eval
-   `(let ~(vec (mapcat symbolize-keys bindings)) ~(read-string form))))
+  "Evals a form with given locals.  The locals should be a map of symbols to
+  values."
+  [locals form]
+  (binding [*locals* locals]
+    (eval
+     `(let ~(vec (mapcat #(list (symbol (name %)) `(*locals* '~%)) (keys locals)))
+        ~(read-string form)))))

 (defn context-get
   "Given a context stack and key, implements the rules for getting the


Some ideas, let's start coding them

Some ideas, let's start coding them

--- src/tick/interval.clj
+++ src/tick/interval.clj
@@ -48,6 +48,37 @@
   (if (neg? (compare v1 v2))
     (->Interval v1 v2)
     (->Interval v2 v1)))
+
+;; Derivation
+
+;; [t0 t1] interval between t0 and t1
+;; [t1 t0] interval between t0 and t1
+;; [t0 d] interval between t0 and t0+d, where d is a given duration
+;; [d t1] interval between t1-d and t1, where d is a given duration
+
+;; Adjustments
+
+;; (extend _ & durations) to extend the interval, add durations to the end
+;; Durations can be negative, so a retraction is simply an extend with a negative duration.
+
+;; (scale _ &amounts) to extend the interval by multiples
+
+;; An interval of duration d to t1 can be constructed like this:
+;; (scale (interval t1 d) -1)
+
+;; (>> _ d) to shift the interval into the future by duration d
+;; (<< _ d) to shift the interval into the past by duration d
+
+;; (* _) to duplicate into meeting intervals, into a sequence (possibly need a record container for this, IntervalSeq)
+
+;; (interpose IntervalSeq d)
+
+;; / to divide into subintervals
+
+;; Finally, it should be possible to transduce IntervalSeqs
+
+
+;; Reification

 (extend-protocol t/ITimeReify
   Interval


systems-toolbox 0.1.14-SNAPSHOT

systems-toolbox 0.1.14-SNAPSHOT

--- Clojure-Websockets/MainApp/project.clj
+++ Clojure-Websockets/MainApp/project.clj
@@ -7,7 +7,7 @@
                  [clojurewerkz/elastisch "2.2.0-beta2"]
                  [org.clojure/tools.logging "0.3.1"]
                  [com.matthiasnehlsen/inspect "0.1.12"]
-                 [matthiasn/systems-toolbox "0.1.13-SNAPSHOT"]
+                 [matthiasn/systems-toolbox "0.1.14-SNAPSHOT"]
                  [org.clojure/tools.namespace "0.2.10"]
                  [ch.qos.logback/logback-classic "1.1.2"]
                  [com.taoensso/sente "1.4.1"]


working on moving to generate2

working on moving to generate2

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -173,23 +173,23 @@
                                  take-n))))))))
 (defn generate2
   "Return all expressions matching spec _spec_ given the model _model_."
-  [spec model
+  [spec language-model
    & {:keys [max-total-depth truncate-children lexicon take]
       :or {max-total-depth max-total-depth
            lexicon nil
            truncate-children true
-           take false}}]
+           take 1}}]
   (log/debug (str "generate2: spec: " spec))
   (let [depth 0
         spec (if (fail? (unify spec {:synsem {:subcat []}}))
                spec
                (unify spec {:synsem {:subcat []}}))
         max-depth max-total-depth]
-     (flatten
-      (mapfn #(do
-                (log/debug (str "top-level add-bolt-at: " ((:morph-ps model) %)))
-                (add-bolt-at % % [] % model depth max-depth truncate-children take))
-             (lightning-bolts model spec 0 max-total-depth)))))
+    (first (flatten
+            (mapfn #(do
+                      (log/debug (str "top-level add-bolt-at: " ((:morph-ps language-model) %)))
+                      (add-bolt-at % % [] % language-model depth max-depth truncate-children take))
+                   (lightning-bolts language-model spec 0 max-total-depth))))))

 (defn generate-n
   "Returns all possible expressions generated by the given language model, constrained by the given spec.


cleanup

cleanup

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -21,7 +21,6 @@

 (declare add-all-comps)
 (declare add-all-comps-with-paths)
-(declare add-complements)
 (declare add-complement-to-bolt)
 (declare bolt-depth)
 (declare candidate-parents)


+(defn over) for diagnosis

+(defn over) for diagnosis

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -5,6 +5,7 @@
    [babel.italiano.grammar :refer [medium]]
    [babel.italiano.morphology :as morph]
    [babel.generate :as generate :refer [try-hard-to]]
+   [babel.over :as over]
    [babel.parse :as parse]
    [clojure.repl :refer [doc]]
    [clojure.string :as string]
@@ -95,6 +96,11 @@
   (map #(string/split % tokenizer)
        (morph/replace-over [string])))

+(defn over
+  "given a parent and 2 children, try to arrange them with the first child on the left and the second child on the right."
+  [parent child1 child2]
+  (over/over parent child1 child2))
+
 (defn parse
   "parse a string in Italian into zero or more (hopefully more) phrase structure trees"


update help doc

update help doc

--- src/cake/tasks/help.clj
+++ src/cake/tasks/help.clj
@@ -31,7 +31,8 @@
       (println (format taskdoc name doc)))))

 (deftask help
-  "Print tasks with documentation (use -a for all tasks)."
+  "Print tasks with documentation. Use 'cake help TASK' for more details."
+  "You can use 'cake help -a' to list all tasks, including those without documentation."
   (if-let [names (:help opts)]
     (apply task-doc (map symbol names))
     (list-all-tasks)))


add time summary to test results

add time summary to test results

--- src/cake/tasks/test.clj
+++ src/cake/tasks/test.clj
@@ -132,7 +132,8 @@
     (bake-ns (:use bake.test clojure.test
                    [clojure.string :only [join]]
                    [bake.core :only [with-context in-project-classloader?]])
-             (let [{:keys [ns-count test-count assertion-count pass-count fail-count error-count]}
+             (let [start (System/currentTimeMillis)
+                   {:keys [ns-count test-count assertion-count pass-count fail-count error-count]}
                    (reduce (fn [acc {:keys [ns test-count assertion-count pass-count fail-count error-count]}]
                              (-> acc
                                  (update-in [:ns-count] + 1)
@@ -148,8 +149,13 @@
                                                          (merge (test-opts) (apply hash-map opts)))]
                              (report-ns ns (bake-invoke run-ns-tests ns tests))))]
                (println (ansi/style (apply str (repeat 50 " ")) :underline))
-               (println (format "\nRan %d tests across %d namespaces, containing %d assertions in %d seconds."
-                                test-count ns-count assertion-count 40))
+               (println (format "\nRan %d tests across %d namespaces, containing %d assertions in %.2f seconds."
+                                test-count
+                                ns-count
+                                assertion-count
+                                (/ (- (System/currentTimeMillis)
+                                      start)
+                                   1000.0)))
                (println (ansi/style (format "%d OK, %d failures, %d errors." pass-count fail-count error-count)
                                     (if (= 0 (+ fail-count error-count)) :green :red)))))))


spec algorithms

spec algorithms

--- src/snergly/algorithms.cljc
+++ src/snergly/algorithms.cljc
@@ -1,12 +1,14 @@
 (ns snergly.algorithms
   #?(:clj (:import  [clojure.lang PersistentQueue]))
   #?(:cljs (:require-macros [cljs.core.async.macros :refer [go go-loop]]))
-  (:require #?(:clj [clojure.core.async :as async :refer [go go-loop]]
+  (:require #?(:clj [clojure.spec :as s]
+               :cljs [cljs.spec :as s])
+            #?(:clj [clojure.core.async :as async :refer [go go-loop]]
                :cljs [cljs.core.async :as async])
-                    [clojure.set :as set]
-                    [snergly.grid :as g]
-                    [snergly.util :as util]
-                    [snergly.grid :as grid]))
+            [clojure.set :as set]
+            [snergly.grid :as g]
+            [snergly.util :as util]
+            [snergly.grid :as grid]))

 ;; When adding a new algorithm, also add it to algorithm-functions below.
 (def algorithm-names
@@ -16,6 +18,17 @@
     "wilsons"
     "hunt-and-kill"
     "recursive-backtracker"})
+
+;; All of the algorithms obey the same interface.
+(defmacro fdef-algorithm [name]
+  (let [fn-name (str name "-seq")]
+    `(s/fdef ~(symbol fn-name)
+             :args (s/cat :grid ::g/grid)
+             :ret (s/and seq? (s/every ::g/grid)))))
+
+(doseq [alg algorithm-names]
+  (fdef-algorithm alg))
+(fdef-algorithm "pessimal")

 ;; necessary because (.indexOf) doesn't work properly in ClojureScript.
 (defn cljs-index-of [s val]


Adding runtime validation that a connection manager is returned for every request.

--- transmit-lib/src/cmr/transmit/http_helper.clj
+++ transmit-lib/src/cmr/transmit/http_helper.clj
@@ -87,9 +87,15 @@
   [context app-name {:keys [url-fn method http-options response-handler use-system-token?] :as request}]
   (let [conn (config/context->app-connection context app-name)
         response-handler (or response-handler default-response-handler)
+        connection-params (config/conn-params conn)
+
+        ;; Validate that a connection manager is always present. This can cause poor performance if not.
+        _ (when-not (:connection-manager connection-params)
+            (errors/internal-error! (format "No connection manager created for [%s] in current application" app-name)))
+
         response (http-response->raw-response
                    (client/request
-                     (merge (config/conn-params conn)
+                     (merge connection-params
                             {:url (url-fn conn)
                              :method method
                              :throw-exceptions false}
@@ -97,7 +103,6 @@
                               {:headers {config/token-header (config/echo-system-token)}})
                             http-options)))]
     (response-handler request response)))
-

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CRUD Macros


DB커넥션 변경

DB커넥션 변경

--- src/tweetbook/models/db.clj
+++ src/tweetbook/models/db.clj
@@ -4,19 +4,23 @@
             [monger.query :as mq]
             [tweetbook.models.config :as config]))

-(def db (:db (mg/connect-via-uri config/db-uri)))
-
 (defn insert-msg [msg]
-  (mc/insert db "quotes" msg))
+  (let [{:keys [conn db]} (mg/connect-via-uri config/db-uri)]
+    (mc/insert db "quotes" msg)
+    (mg/disconnect conn)))

 (defn list-msgs []
-  (println (mc/find-maps db "quotes")))
+  (let [{:keys [conn db]} (mg/connect-via-uri config/db-uri)]
+    (println (mc/find-maps db "quotes"))
+    (mg/disconnect conn)))

 (defn random-msg []
-  (let [cnt (mc/count db "quotes")
+  (let [{:keys [conn db]} (mg/connect-via-uri config/db-uri)
+        cnt (mc/count db "quotes")
         rnd (rand-int cnt)
         {:keys [msg src]} (first (mq/with-collection db "quotes"
                                    (mq/skip rnd)
                                    (mq/limit 1)
                                    (mq/snapshot)))]
+    (mg/disconnect conn)
     (str msg "\n" src)))


remove gender :note from reflexive pronouns: the subject's notes, if any, should be sufficient

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1132,8 +1132,7 @@
               :subcat '()}}]

    "itself"
-   [{:english {:note "♂"}
-     :synsem {:cat :noun
+   [{:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -1142,8 +1141,7 @@
                     :number :sing}
               :sem {:human false}
               :subcat '()}}
-    {:english {:note "♀"}
-     :synsem {:cat :noun
+    {:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -1395,8 +1393,7 @@
          {:synsem {:agr {:number :plur}}}])

    "ourselves"
-   [{:english {:note "♀"}
-     :synsem {:cat :noun
+   [{:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -1406,8 +1403,7 @@
               :sem {:human true}
               :subcat '()}}

-    {:english {:note "♂"}
-     :synsem {:cat :noun
+    {:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -1822,8 +1818,7 @@
          {:synsem {:agr {:number :plur}}}])

    "themselves"
-   [{:english {:note "♀"}
-     :synsem {:cat :noun
+   [{:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -1833,8 +1828,7 @@
               :sem {:reflexive true}
               :subcat '()}}

-    {:english {:note "♂"}
-     :synsem {:cat :noun
+    {:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -2169,8 +2163,7 @@
          {:synsem {:agr {:number :plur}}}])

    "yourself"
-   [{:english {:note "♀"}
-     :synsem {:cat :noun
+   [{:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -2181,8 +2174,7 @@
                    :pred :tu}
               :subcat '()}}

-    {:english {:note "♂"}
-     :synsem {:cat :noun
+    {:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -2194,8 +2186,7 @@
               :subcat '()}}]

    "yourselves"
-   [{:english {:note "♀"}
-     :synsem {:cat :noun
+   [{:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true
@@ -2206,8 +2197,7 @@
                     :pred :voi}
               :subcat '()}}

-    {:english {:note "♂"}
-     :synsem {:cat :noun
+    {:synsem {:cat :noun
               :pronoun true
               :case :acc
               :reflexive true


music is +mass (e.g. *"a music")

music is +mass (e.g. *"a music")

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1030,6 +1030,7 @@
                 :sem {:pred :multiply}}}
    "music"
    {:synsem {:cat :noun
+             :mass true
              :sem {:pred :music}}}
    "my"
    (map #(unify %


"worry" is semantically reflexive

"worry" is semantically reflexive

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2473,7 +2473,8 @@
                       :participle "worrying"
                       :past-participle "worried"}
             :synsem {:cat :verb
-                     :sem {:pred :worry}}}
+                     :sem {:reflexive true
+                           :pred :worry}}}

    "write"  {:english {:past "wrote"
                        :past-participle "written"}


added contare

added contare

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -645,6 +645,9 @@
       "considerare"  {:synsem {:cat :verb
                                :sem {:pred :consider}}}

+      "contare" {:synsem {:sem {:pred :count}
+              :cat :verb}}
+
       "contento"
       [(let [complement-complement-sem (ref {:human true})
              complement-sem (ref {:pred :di


implemented new users-in-open-group by status subscription in header

--- src/braid/ui/views/header.cljs
+++ src/braid/ui/views/header.cljs
@@ -47,24 +47,20 @@
 (defn users-online-pane-view []
   (let [open-group-id (subscribe [:open-group-id])
         user-id (subscribe [:user-id])
-        users-in-open-group (subscribe [:users-in-open-group])]
+        users (subscribe [:users-in-open-group :online])]
     (fn []
-      (let [users (->> @users-in-open-group
-                   (remove (fn [user]
+      (let [users (->> @users
+                       (remove (fn [user]
                                    (= @user-id
                                       (user :id)))))
-            users-online (->> users
-                              (filter (fn [user]
-                                        (= :online
-                                           (user :status)))))
             path (routes/users-page-path {:group-id @open-group-id})]
         [:div.users.shortcut {:class (when (routes/current-path? path) "active")}
           [:a.title {:href path
                      :title "Users"}
-                  (count users-online)]
+                  (count users)]
                  [:div.modal
                   [:h2 "Online"]
-                  (for [user users-online]
+                  (for [user users]
                     ^{:key (user :id)}
                     [user-pill-view user])]]))))


register defn-args spec

register defn-args spec

Signed-off-by: Rich Hickey <2f3b32171da334ad5d7d0db393d0928eef4308ab@gmail.com>

--- src/clj/clojure/core/specs.clj
+++ src/clj/clojure/core/specs.clj
@@ -75,7 +75,7 @@
          :prepost (s/? map?)
          :body (s/* any?)))

-(def defn-args
+(s/def ::defn-args
   (s/cat :name simple-symbol?
          :docstring (s/? string?)
          :meta (s/? map?)
@@ -84,11 +84,11 @@
                                     :attr (s/? map?)))))

 (s/fdef clojure.core/defn
-  :args defn-args
+  :args ::defn-args
   :ret any?)

 (s/fdef clojure.core/defn-
-  :args defn-args
+  :args ::defn-args
   :ret any?)

 (s/fdef clojure.core/fn
@@ -198,4 +198,4 @@
           :docstring (s/? string?)
           :attr-map (s/? map?)
           :clauses ::ns-clauses)
-  :ret any?)+  :ret any?)


Correct parameter name for chapter-list related things

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -50,8 +50,8 @@
                         :selector [:div.series_alpha :ul :li :a]
                         :normalize link->map}
       :chapter-list-data-for-comic
-      (fn [chapter-url]
-        {:url chapter-url
+      (fn [comic-url]
+        {:url comic-url
          :selector [:div#chapterlist :tr :td :a]
          :normalize link->map})
       :page-list-data-for-comic-chapter
@@ -81,9 +81,9 @@
   (-> (get-site site)
       fn-key))

-(defn chapter-list-data [site chapter-url]
+(defn chapter-list-data [site comic-url]
   ((get-data-fn site :chapter-list-data-for-comic)
-   chapter-url))
+   comic-url))

 (defn page-list-data [site chapter-url]
   ((get-data-fn site :page-list-data-for-comic-chapter)


WIP refine account rendering

WIP refine account rendering

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -172,9 +172,14 @@

 (defmulti ^:private show-account
   (fn [account params]
-    (:content-type account)))
-
-(defmethod ^:private show-account :currency
+    (cond
+      (-> account :commodity :default)
+      :trading-detail
+
+      :else
+      :standard)))
+
+(defmethod ^:private show-account :standard
   [account params]
   (html
     [:table.table.table-striped.table-hover
@@ -265,7 +270,7 @@
                       :level :danger
                       :title "Click here to sell shares of this commodity."})])]])

-(defmethod show-account :commodities
+(defmethod show-account :trading-account
   [account params]
   (html
     (let [summary (reports/commodities-account-summary (env :db) (:id account))]
@@ -295,7 +300,7 @@
       :title "Click here to return to the list of accounts"}
      "Back"]))

-(defmethod show-account :commodity
+(defmethod show-account :trading-detail
   [account params]
   (html
     [:p


Fix order of bin index

Fix order of bin index

--- src/cljam/bam_index/writer.clj
+++ src/cljam/bam_index/writer.clj
@@ -60,7 +60,7 @@
          lidx* []
          last-non-zero 0]
     (if (<= i largest-lidx-seen)
-      (let [l (nth lidx i)]
+      (let [l (long (nth lidx i))]
         (if (zero? l)
           (recur (inc i) (conj lidx* last-non-zero) last-non-zero)
           (recur (inc i) (conj lidx* l) l)))
@@ -102,6 +102,13 @@
                  (conj (pop chunks) l))
                (conj chunks achunk))
              (vector achunk)))))
+
+(defn- finish-bin-index
+  [bin-index]
+  (->> bin-index
+       (seq)
+       (sort-by first)
+       (map (partial zipmap [:bin :chunks]))))

 (defn- init-linear-index []
   {:index (gen-vec max-lidx-size 0)
@@ -159,13 +166,13 @@
                                   no-coordinate-alns)
             indices' (if new-ref?
                        (assoc indices ref-name {:meta (:meta-data idx-status)
-                                                :bins (:bin-index idx-status)
+                                                :bins (finish-bin-index (:bin-index idx-status))
                                                 :lidx (optimize-lidx (:index (:linear-index idx-status))
                                                                      (:largest-seen (:linear-index idx-status)))})
                        indices)]
         (recur rest ref-name' idx-status' no-coordinate-alns' indices'))
       (assoc indices ref-name {:meta (:meta-data idx-status)
-                               :bins (:bin-index idx-status)
+                               :bins (finish-bin-index (:bin-index idx-status))
                                :lidx (optimize-lidx (:index (:linear-index idx-status))
                                                     (:largest-seen (:linear-index idx-status)))}
                      :no-coordinate-alns no-coordinate-alns))))
@@ -221,7 +228,7 @@
             ;; # of bins
             (lsb/write-int wtr (inc n-bin))
             (doseq [bin (:bins index)]
-              (write-bin wtr (first bin) (second bin)))
+              (write-bin wtr (:bin bin) (:chunks bin)))
             ;; meta data
             (write-meta-data wtr (:meta index))))
         ;; linear index


Unbox local variables

Unbox local variables

--- src/cljam/io/twobit/reader.clj
+++ src/cljam/io/twobit/reader.clj
@@ -106,8 +106,8 @@
    (read-sequence rdr region {}))
   ([^TwoBitReader rdr {:keys [chr start end]} {:keys [mask?] :or {mask? false}}]
    (when-let [^Chrom c (get (.index rdr) chr)]
-     (let [start' (max 1 (or start 1))
-           end' (min (.len c) (or end (.len c)))]
+     (let [start' (long (max 1 (or start 1)))
+           end' (long (min (.len c) (or end (.len c))))]
        (when (<= start' end')
          ;; Potential seek & read.
          (let [^ChromHeader h @(.header c)


Replace mapv with map

Replace mapv with map

--- src/cljam/io/twobit/reader.clj
+++ src/cljam/io/twobit/reader.clj
@@ -58,7 +58,7 @@
   (let [table "TCAG"]
     (->> 256
          range
-         (mapv
+         (map
           (fn [j] (let [i (byte (- j 128))
                         n4 (bit-and i 2r11)
                         n3 (bit-and (unsigned-bit-shift-right i 2) 2r11)


Editing *now* works on subsequent pages from first

--- src/cljs/modern_cljs/core.cljs
+++ src/cljs/modern_cljs/core.cljs
@@ -108,8 +108,9 @@
   "Returns 10 items from data"
   (map-indexed
     (fn [i item]
-      (let [title (get item "title")]
-          (m "li" nil [(m "button" {:onclick #(edit item i)} "Edit")
+      (let [title (get item "title")
+            pos (+ start i)]
+          (m "li" nil [(m "button" {:onclick #(edit item pos)} "Edit")
                        title])))
     (take PAGESIZE (drop start data))))


Focus on console when 'Run with REPL' is hit

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -57,48 +57,40 @@
   []
   (let [console (JConsole.)
         in (LineNumberingPushbackReader. (.getIn console))
-        out (.getOut console)]
+        out (.getOut console)
+        run-action (fn [e]
+                     (lein/run-project in out (p/get-project-path)))
+        run-repl-action (fn [e]
+                          (lein/run-repl-project in out (p/get-project-path))
+                          (s/request-focus! (.getView (.getViewport console))))
+        build-action (fn [e]
+                       (lein/build-project in out (p/get-project-path)))
+        test-action (fn [e]
+                      (lein/test-project in out (p/get-project-path)))
+        clean-action (fn [e]
+                       (lein/clean-project in out (p/get-project-path)))
+        halt-action (fn [e]
+                      (lein/halt-project))]
     (s/vertical-panel
       :items [(s/horizontal-panel
                 :items [(s/button :id :run-button
                                   :text "Run"
-                                  :listen [:action (fn [e]
-                                                     (lein/run-project
-                                                       in
-                                                       out
-                                                       (p/get-project-path)))])
+                                  :listen [:action run-action])
                         (s/button :id :run-repl-button
                                   :text "Run with REPL"
-                                  :listen [:action (fn [e]
-                                                     (lein/run-repl-project
-                                                       in
-                                                       out
-                                                       (p/get-project-path)))])
+                                  :listen [:action run-repl-action])
                         (s/button :id :build-button
                                   :text "Build"
-                                  :listen [:action (fn [e]
-                                                     (lein/build-project
-                                                       in
-                                                       out
-                                                       (p/get-project-path)))])
+                                  :listen [:action build-action])
                         (s/button :id :test-button
                                   :text "Test"
-                                  :listen [:action (fn [e]
-                                                     (lein/test-project
-                                                       in
-                                                       out
-                                                       (p/get-project-path)))])
+                                  :listen [:action test-action])
                         (s/button :id :clean-button
                                   :text "Clean"
-                                  :listen [:action (fn [e]
-                                                     (lein/clean-project
-                                                       in
-                                                       out
-                                                       (p/get-project-path)))])
+                                  :listen [:action clean-action])
                         (s/button :id :halt-button
                                   :text "Halt"
-                                  :listen [:action (fn [e]
-                                                     (lein/halt-project))])
+                                  :listen [:action halt-action])
                         :fill-h])
               (s/config! console :id :build-console)])))


Wait longer for android REPL

Wait longer for android REPL

--- src/clojure/nightcode/lein.clj
+++ src/clojure/nightcode/lein.clj
@@ -255,7 +255,7 @@
     (when-let [project (read-android-project project)]
       (doseq [cmd ["doall" "repl"]]
         (leiningen.droid/execute-subtask project cmd [])
-        (Thread/sleep 10000)))
+        (Thread/sleep 15000)))
     :else
     (leiningen.repl/repl project)))


Type-hint rec-get via :inline instead of making a macro.

--- src/clojure/parenskit/core.clj
+++ src/clojure/parenskit/core.clj
@@ -19,9 +19,8 @@
   {:tag `LenskitRecommender}
   [config] (LenskitRecommender/build config))

-(defmacro rec-get
-  "Get instance of injected implementation of class `cls` from configured
-recommender `rec`, with optional qualifier annotation `ann`."
+(defn ^:private rec-get*
+  "Type-hinted form for LenskitRecommender#get invocation."
   ([rec cls]
      (let [rec (vary-meta rec assoc :tag `LenskitRecommender)
            cls (vary-meta cls assoc :tag `Class)]
@@ -31,3 +30,10 @@
            ann (vary-meta ann assoc :tag `Class)
            cls (vary-meta cls assoc :tag `Class)]
        (vary-meta `(.get ~rec ~ann ~cls) assoc :tag cls))))
+
+(defn rec-get
+  "Get instance of injected implementation of class `cls` from configured
+recommender `rec`, with optional qualifier annotation `ann`."
+  {:inline (identity rec-get*), :inline-arities #{2 3}}
+  ([^LenskitRecommender rec ^Class cls] (.get rec cls))
+  ([^LenskitRecommender rec ^Class ann ^Class cls] (.get rec ann cls)))


Fixed body params; temporarily remove _method override

--- src/compojure/http/servlet.clj
+++ src/compojure/http/servlet.clj
@@ -35,15 +35,6 @@
     {}
     (enumeration-seq (.getHeaderNames request))))

-(defn- get-method
-  "Returns either the value of the '_method' HTTP parameter, or the method
-  of the HTTP request."
-  [#^HttpServletRequest request]
-  (keyword
-    (.toLowerCase
-      (or (.getParameter request "_method")
-          (.getMethod request)))))
-
 (defn- get-content-length
   "Returns the content length, or nil if there is no content."
   [#^HttpServletRequest request]
@@ -60,7 +51,7 @@
    :uri                (.getRequestURI request)
    :query-string       (.getQueryString request)
    :scheme             (keyword (.getScheme request))
-   :request-method     (get-method request)
+   :request-method     (keyword (.toLowerCase (.getMethod request)))
    :headers            (get-headers request)
    :content-type       (.getContentType request)
    :content-length     (get-content-length request)


Prepare for changes

Prepare for changes

--- src/degasolv/resolver_core.clj
+++ src/degasolv/resolver_core.clj
@@ -228,8 +228,8 @@
    []
    coll))

-;; does one of the present packages already
-;; satisfy criteria?
+;; Does one of the present packages already
+;; satisfy criteria? If so, return it.
 (defn- present-packages-satisfies?
   [present-id-packages
    spec
@@ -292,6 +292,8 @@
                found-packages
                absent-specs
                clauses]
+;;               parent
+;;               package-graph]
               (if (empty? clauses)
                 [:successful (set (flatten (vals found-packages)))]
                 (let [fclause (first clauses)
@@ -312,17 +314,19 @@
                                    alternative
                                    present-id-packages
                                    (or (get present-packages id)
-                                              (get found-packages id))]
+                                                (get found-packages id))
+                                   present-package
+                                   (when (not (nil? present-id-packages))
+                                     (if (= conflict-strat :prioritized)
+                                       (first present-id-packages)
+                                       (present-packages-satisfies?
+                                        present-id-packages
+                                        spec
+                                        safe-spec-call
+                                        status)))]
                                (cond
-                                 (and
                                   (not
-                                   (nil? present-id-packages))
-                                  (or (= conflict-strat :prioritized)
-                                      (present-packages-satisfies?
-                                       present-id-packages
-                                       spec
-                                       safe-spec-call
-                                       status)))
+                                   (nil? present-package))
                                    (resolve-deps
                                     repo
                                     present-packages


removed testing file

removed testing file

--- src/ads_txt_crawler/client.clj
+++ src/ads_txt_crawler/client.clj
@@ -1,49 +0,0 @@
-(ns ads-txt-crawler.client
-  (:require [org.httpkit.client :as http]))
-
-(def url "http://cubshq.com/ads.txt")
-
-(def options  {:follow-redirects true
-               :insecure? true
-               :max-redirects 100})
-
-(defn example []
-  (http/get url options
-            (fn [{:keys [status headers body error]}] ;; asynchronous response handling
-              (if error
-                (println "Failed, exception is " error)
-                (println "Async HTTP GET: " status)))))
-
-
-
-(def foo {:url url
- :method :get             ; :post :put :head or other
- :user-agent "User-Agent string"
- :oauth-token "your-token"
- :headers {"X-header" "value"
-           "X-Api-Version" "2"}
- :query-params {"q" "foo, bar"} ;"Nested" query parameters are also supported
- :form-params {"q" "foo, bar"} ; just like query-params, except sent in the body
- ;; :body (json/encode {"key" "value"}) ; use this for content-type json
- :basic-auth ["user" "pass"]
- :keepalive 3000          ; Keep the TCP connection for 3000ms
- :timeout 1000      ; connection timeout and reading timeout 1000ms
- :filter (http/max-body-filter (* 1024 100)) ; reject if body is more than 100k
- :insecure? true ; Need to contact a server with an untrusted SSL cert?
-
- ;; File upload. :content can be a java.io.File, java.io.InputStream, String
- ;; It read the whole content before send them to server:
- ;; should be used when the file is small, say, a few megabytes
- :multipart [{:name "comment" :content "httpkit's project.clj"}
-             {:name "file" :content (clojure.java.io/file "project.clj") :filename "project.clj"}]
-
- :max-redirects 10 ; Max redirects to follow
- ;; whether follow 301/302 redirects automatically, default to true
- ;; :trace-redirects will contain the chain of the redirections followed.
- :follow-redirects false
- })
-
-
-
-(defn example-test []
-  @(http/get "https://zoeandmorgan.com/media/catalog/product/b/a/base-chakra-n-s-detail.jpg" {:insecure? true}))


飞行高度: (swap! flap-state jump)

飞行高度: (swap! flap-state jump)

--- src/flappy_bird_demo/core.cljs
+++ src/flappy_bird_demo/core.cljs
@@ -179,6 +179,7 @@
                              timer-running border-pos
                              flappy-y pillar-list]}]
   (sab/html [:div.board { :onMouseDown (fn [e]
+                                         ;; 鼠标单击修改飞行高度
                                          (swap! flap-state jump)
                                          (.preventDefault e))}
              [:h1.score score]


#  鼠标单击修改飞行高度 (swap! flap-state jump)
# 柱子是(map pillar pillar-list) map出来的 ===>>> 视图map数据列表
# (start-game) 开始新的游戏 ===>>> reset! flap-state 状态机就 开始新的游戏
######### requestAnimationFrame() 方法告诉浏览器您希望执行动画，并请求浏览器调用指定的函数在下一次重绘之前更新动画 ####
######## requestAnimationFrame是浏览器用于定时循环操作的一个接口，类似于setTimeout，主要用途是按帧对网页进行重绘 #####
# time-update ==>> 依次刷新视图对应函数 ==>> state, update-flappy(刷新小鸟位置), update-pillars(刷新柱子), collision?(是否死了), score>分数
# class=flappy =>> 小鸟飞行的高度 flappy-y

### 死了的过滤条件 ==>>  collision? ==>>  collision     英[kəˈlɪʒn] === 碰撞
# in-pillar? 是否撞了柱子
# in-pillar-gap? 是否撞了柱子接触面
# bottom-collision? 是否撞了地面
### (assoc st :timer-running false) ;;时间run就停止了 ===>> 生命的时间就停止了😂  😂  😂

--- src/flappy_bird_demo/core.cljs
+++ src/flappy_bird_demo/core.cljs
@@ -111,7 +111,7 @@
   (if (some #(or (and (in-pillar? %)
                       (not (in-pillar-gap? st %)))
                  (bottom-collision? st)) pillar-list)
-    (assoc st :timer-running false) ;;时间run就停止了
+    (assoc st :timer-running false) ;;时间run就停止了=> 生命的时间就停止了😂  😂  😂
     st))

 (defn new-pillar [cur-time pos-x]
@@ -279,6 +279,7 @@
                [:span])
              [:div (map pillar pillar-list)]
              [:div.flappy {:style {:top (px flappy-y)}}]
+             ;; border-pos 是变化的背景
              [:div.scrolling-border {:style { :background-position-x (px border-pos)}}]]))

 (let [node (.getElementById js/document "board-area")]


fix irregular present for "boire"

fix irregular present for "boire"

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -93,7 +93,10 @@

    "boire" {:français {:past-participle "bu"
                        :boot-stem1 "boiv"
-                       :boot-stem2 "buv"}
+                       :boot-stem2 "buv"
+                       :present {:1sing "bois"
+                                 :2sing "boit"
+                                 :3sing "boit"}}
             :synsem {:cat :verb
                      :sem {:pred :drink}}}


add "nous" in both genders

add "nous" in both genders

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -343,15 +343,26 @@
   "mettre" {:synsem {:cat :verb
                      :sem {:pred :set}}}
   "nous"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :nom
-             :agr {:person :1st
-                   :number :plur}
-              :sem {:human true
-                    :pred :noi}
-             :subcat '()}}
-
+  ;; TODO: factor out to francais/pos.
+  (let [gender (ref :top)
+        gender-agreement {:synsem {:agr {:gender gender}
+                                   :sem {:gender gender}}}
+        common {:synsem {:cat :noun
+                         :pronoun true
+                         :case :nom
+                         :agr {:person :1st
+                               :gender :fem
+                               :number :plur}
+                         :sem {:human true
+                               :pred :noi}
+                         :subcat '()}}]
+    [(unify gender-agreement
+            common
+            {:synsem {:agr {:gender :fem}}})
+     (unify gender-agreement
+            common
+            {:synsem {:agr {:gender :masc}}})])
+
    "observer" {:synsem {:cat :verb
                        :sem {:pred :observe}}}


fix 'capire' and 'colpire'

fix 'capire' and 'colpire'

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1096,11 +1096,11 @@
               :synsem {:cat :verb
                        :sem {:pred :finish}}}

-      "formare"  {:synsem {:cat :verb
-                           :sem {:pred :form}}}
-
-      "fornire"  {:synsem {:cat :verb
-                           :sem {:pred :furnish}}}
+   "formare"  {:synsem {:cat :verb
+                        :sem {:pred :form}}}
+
+   "fornire"  {:synsem {:cat :verb
+                        :sem {:pred :furnish}}}

 ;; commenting out: no english equivalent
 ;      "frequentare"  {:synsem {:cat :verb


Microdosing!

Microdosing!

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -41,4 +41,5 @@
     "All aboard the coffee train\n:steam_locomotive::coffee::coffee::running::running::running::dash:"
     "Det er kaffi å få på kjøken!"
     "KEEP CALM THE COFFEE IS READY!"
+    "M-m-m-m-m-microdosing! :syringe::syringe::syringe::exclamation:"
     "PLEASE PROCEED IN ORDERLY FASHION TO RECEIVE COFFEE :syringe:"]))


Refactor code

Refactor code

--- src/clj/salava/core/layout.clj
+++ src/clj/salava/core/layout.clj
@@ -54,7 +54,7 @@
 (defn js-list [ctx]
     (map #(with-version ctx %) (conj asset-js "/js/salava.js")))

-(defn plugin-js [ctx]
+(defn plugin-js-list [ctx]
  (let [f (first (plugin-fun (get-plugins ctx) "block" "pluginjs"))]
    (if f (f ctx) "")))

@@ -137,7 +137,7 @@
        "<![endif]-->"
        (include-js "/assets/es6-shim/es6-shim.min.js" "/assets/es6-shim/es6-sham.min.js")
        (apply include-js (js-list ctx))
-       (apply include-js (plugin-js ctx))]))))
+       (apply include-js (plugin-js-list ctx))]))))

 (defn main-response [ctx current-user flash-message meta-tags]


Remove unused functions

Remove unused functions

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -8,6 +8,8 @@
             [clj-time.local :as local-time]
             [clojure.set :refer [rename-keys]]
             [clojure.core.async :as async :refer [go go-loop close! put! <!! alts! <! >!]]))
+
+(set! *warn-on-reflection* true)

 (defn- now [] (System/currentTimeMillis))

@@ -22,19 +24,6 @@
           [(first result) (now) (second result)]))
       (catch Exception _
         [false (now) ctx]))))
-
-(defn- bench [f]
-  (fn [start-promise end-promise callback context]
-    (deliver start-promise (now))
-    (f (fn [result & [context]]
-         (deliver end-promise (now))
-         (callback result context))
-       context)))
-
-(defn- request-fn [request]
-  (bench (if-let [url (:http request)]
-            (partial http/async-http-request url)
-            (:fn request))))

 (defn async-function-with-timeout [request timeout sent-requests user-id context]
   (swap! sent-requests inc)
@@ -51,33 +40,6 @@
           [{:name (:name request)
             :id user-id
             :start start
-            :end (now)
-            :result false} context])))))
-
-(defn async-function-with-timeout-old [request timeout sent-requests user-id context]
-  (let [start-promise (promise)
-        end-promise (promise)
-        response (async/chan)
-        exception-chan (async/chan)
-        function (memoize (request-fn request))
-        callback (fn [result context]
-                   (put! response [{:name (:name request)
-                                    :id user-id
-                                    :start @start-promise
-                                    :end @end-promise
-                                    :result result} context]))]
-    (go
-      (try
-        (swap! sent-requests inc)
-        (function start-promise end-promise callback (assoc context :user-id user-id))
-      (catch Exception e
-        (put! exception-chan e)))
-      (let [[result c] (alts! [response (async/timeout timeout) exception-chan])]
-        (if (= c response)
-          result
-          [{:name (:name request)
-            :id user-id
-            :start @start-promise
             :end (now)
             :result false} context])))))


Refactor

Refactor

--- src/cljam/bam_index/writer.clj
+++ src/cljam/bam_index/writer.clj
@@ -89,67 +89,51 @@
 ;; index
 ;;

-(defrecord ^:private MetaData
-  [first-offset last-offset aligned-alns unaligned-alns])
-
-(defn- meta-data
-  ([]
-     (MetaData. -1 0 0 0))
-  ([first-offset last-offset aligned-alns unaligned-alns]
-     (MetaData. first-offset last-offset aligned-alns unaligned-alns)))
-
-(defrecord ^:private LinearIndexStatus
-  [lidx largest-lidx-seen])
-
-(defn- linear-index-status
-  ([]
-     (LinearIndexStatus. (gen-vec max-lidx-size 0) -1))
-  ([lidx largest-lidx-seen]
-     (LinearIndexStatus. lidx largest-lidx-seen)))
-
-(defrecord ^:private IndexStatus
-  [bin-index linear-index-status meta-data])
-
-(defn- index-status
-  ([]
-     (IndexStatus. {} (linear-index-status) (meta-data)))
-  ([bin-index linear-index-status meta-data]
-     (IndexStatus. bin-index linear-index-status meta-data)))
+(defn- init-meta-data []
+  {:first-offset  -1
+   :last-offset    0
+   :aligned-alns   0
+   :unaligned-alns 0})

 (defn- update-meta-data
   [meta-data aln]
   (let [{:keys [first-offset last-offset aligned-alns unaligned-alns]} meta-data
-        {:keys [beg end]} (:chunk (:meta aln))
-        ;; Update
-        first-offset'   (if (or (< (bgzf-util/compare beg first-offset) 1)
-                                (= first-offset -1))
-                          beg first-offset)
-        last-offset'    (if (< (bgzf-util/compare last-offset end) 1)
-                          end last-offset)
-        aligned-alns'   (if (zero? (bit-and (:flag aln) 4))
-                          (inc aligned-alns) aligned-alns)
-        unaligned-alns' (if-not (zero? (bit-and (:flag aln) 4))
-                          (inc unaligned-alns) unaligned-alns)]
-    (->MetaData first-offset' last-offset' aligned-alns' unaligned-alns')))
-
-;;; bin-index > {bin1 chunks1, bin2 chunks2, ...}
-;;; e.g. {8  [{:beg 0, :end 10} ...]
-;;;       10 [...]}
+        {:keys [beg end]} (:chunk (:meta aln))]
+    (assoc meta-data
+      :first-offset   (if (or (< (bgzf-util/compare beg first-offset) 1)
+                              (= first-offset -1))
+                        beg first-offset)
+      :last-offset    (if (< (bgzf-util/compare last-offset end) 1)
+                        end last-offset)
+      :aligned-alns   (if (zero? (bit-and (:flag aln) 4))
+                        (inc aligned-alns) aligned-alns)
+      :unaligned-alns (if-not (zero? (bit-and (:flag aln) 4))
+                        (inc unaligned-alns) unaligned-alns))))
+
+(defn- init-bin-index
+  "bin-index > {bin1 chunks1, bin2 chunks2, ...}
+  e.g. {4681 [{:beg 97, :end 555} ...], 37450 [...] ...}"
+  [] {})

 (defn- update-bin-index
   [bin-index aln]
   (let [{:keys [beg end] :as achunk} (:chunk (:meta aln))
         bin (sam-util/compute-bin aln)]
-    (if-let [chunks (get bin-index bin)]
-      (if (bgzf-util/same-or-adjacent-blocks? (:end (last chunks)) beg)
-        (let [l (assoc (last chunks) :end end)]
-          (assoc bin-index bin (conj (pop chunks) l)))
-        (assoc bin-index bin (conj chunks achunk)))
-      (assoc bin-index bin (vector achunk)))))
-
-(defn- update-linear-index-status
-  [linear-index-status aln]
-  (let [{:keys [lidx largest-lidx-seen]} linear-index-status
+    (assoc bin-index bin
+           (if-let [chunks (get bin-index bin)]
+             (if (bgzf-util/same-or-adjacent-blocks? (:end (last chunks)) beg)
+               (let [l (assoc (last chunks) :end end)]
+                 (conj (pop chunks) l))
+               (conj chunks achunk))
+             (vector achunk)))))
+
+(defn- init-linear-index []
+  {:lidx (gen-vec max-lidx-size 0)
+   :largest-lidx-seen -1})
+
+(defn- update-linear-index
+  [linear-index aln]
+  (let [{:keys [lidx largest-lidx-seen]} linear-index
         {:keys [beg]} (:chunk (:meta aln))
         aln-beg (:pos aln)
         aln-end (+ aln-beg (cgr/count-ref (:cigar aln)))
@@ -159,52 +143,56 @@
         win-end (if (zero? aln-end)
                   win-beg
                   (pos->lidx-offset aln-end))]
-    (let [lidx' (loop [i win-beg, lidx* lidx]
-                  (if (<= i win-end)
-                    (let [l (nth lidx i)]
-                      (if (or (zero? l) (< beg l))
-                        (recur (inc i) (assoc lidx* i beg))
-                        (recur (inc i) lidx*)))
-                    lidx*))
-          largest-lidx-seen' (if (> win-end largest-lidx-seen)
-                               win-end largest-lidx-seen)]
-      (->LinearIndexStatus lidx' largest-lidx-seen'))))
+    (assoc linear-index
+      :lidx (loop [i win-beg, lidx* lidx]
+              (if (<= i win-end)
+                (let [l (nth lidx* i)]
+                  (if (or (zero? l) (< beg l))
+                    (recur (inc i) (assoc lidx* i beg))
+                    (recur (inc i) lidx*)))
+                lidx*))
+      :largest-lidx-seen  (if (> win-end largest-lidx-seen)
+                            win-end largest-lidx-seen))))
+
+(defn- init-index-status []
+  {:bin-index    (init-bin-index)
+   :linear-index (init-linear-index)
+   :meta-data    (init-meta-data)})

 (defn- update-index-status
   [index-status aln]
-  (let [{:keys [bin-index linear-index-status meta-data]} index-status
-        ;; Update
-        meta-data'           (update-meta-data meta-data aln)
-        bin-index'           (update-bin-index bin-index aln)
-        linear-index-status' (update-linear-index-status linear-index-status aln)]
-    (->IndexStatus bin-index' linear-index-status' meta-data')))
+  (let [{:keys [bin-index linear-index meta-data]} index-status]
+    (assoc index-status
+      :meta-data    (update-meta-data meta-data aln)
+      :bin-index    (update-bin-index bin-index aln)
+      :linear-index (update-linear-index linear-index aln))))

 (defn- make-index!
   [refs alns]
   (loop [[aln & rest] alns
          ref-name (:rname aln)
-         idx-status (index-status)
+         idx-status (init-index-status)
          no-coordinate-alns 0
          indices {}]
     (if aln
       (let [ref-name' (:rname aln)
             new-ref? (not= ref-name' ref-name)
             idx-status' (update-index-status
-                         (if new-ref? (index-status) idx-status) aln)
+                         (if new-ref? (init-index-status) idx-status) aln)
             no-coordinate-alns' (if (zero? (:pos aln))
                                   (inc no-coordinate-alns)
                                   no-coordinate-alns)
             indices' (if new-ref?
                        (assoc indices ref-name {:meta (:meta-data idx-status)
                                                 :bins (:bin-index idx-status)
-                                                :lidx (optimize-lidx (:lidx (:linear-index-status idx-status))
-                                                                     (:largest-lidx-seen (:linear-index-status idx-status)))})
+                                                :lidx (optimize-lidx (:lidx (:linear-index idx-status))
+                                                                     (:largest-lidx-seen (:linear-index idx-status)))})
                        indices)]
         (recur rest ref-name' idx-status' no-coordinate-alns' indices'))
       (assoc indices ref-name {:meta (:meta-data idx-status)
                                :bins (:bin-index idx-status)
-                               :lidx (optimize-lidx (:lidx (:linear-index-status idx-status))
-                                                    (:largest-lidx-seen (:linear-index-status idx-status)))}
+                               :lidx (optimize-lidx (:lidx (:linear-index idx-status))
+                                                    (:largest-lidx-seen (:linear-index idx-status)))}
                      :no-coordinate-alns no-coordinate-alns))))

 (defn- make-index


Add optional reference attributes for SAM.

--- src/cljam/io/sam/util/refs.clj
+++ src/cljam/io/sam/util/refs.clj
@@ -1,10 +1,16 @@
 (ns cljam.io.sam.util.refs
-  "Utility functions for SAM references.")
+  "Utility functions for SAM references."
+  (:require [clojure.set :as cset]))
+
 (defn make-refs
   "Return a reference sequence from the sam header."
   [hdr]
-  (for [sq (:SQ hdr)]
-    {:name (:SN sq), :len (:LN sq)}))
+  (map
+   #(cset/rename-keys
+     %
+     {:SN :name, :LN :len, :AH :alt, :AS :assembly,
+      :M5 :md5, :SP :species, :UR :uri})
+   (:SQ hdr)))

 (defn- ref-id*
   [refs name]


Revert.

Revert.

--- src/cljs/beatha/automaton.cljs
+++ src/cljs/beatha/automaton.cljs
@@ -203,8 +203,7 @@
                         :corp-3 :worker-3 :corp-4 :worker-4}
         worker? #((into #{:worker} (vals company-worker)) %)
         company-of-worker (fn [s] (or ((set/map-invert company-worker) s) s))
-        worker-of-company (fn [s] (or (company-worker s) s))
-        test 1]
+        worker-of-company (fn [s] (or (company-worker s) s))]
     (reify
       AutomatonSpecification
       (default-cell [_] {:state :worker})


Add movement from search.

Add movement from search.

--- src/cljs/movement/session.cljs
+++ src/cljs/movement/session.cljs
@@ -48,14 +48,11 @@
                                                       (session/assoc-in! [:movement-session :parts part-number] new-part)))
                                    :error-handler (fn [r] nil)}))

-#_(defn add-movement-from-search [name part-number]
-    (GET "movement" {:params        {:user-id (:user-id (session/get :user))
-                                     :name    name}
-                     :handler       (fn [new-movement]
-                                      (let [part (session/get-in [:movement-session :parts part-number])
-                                            new-part (conj part new-movement)]
-                                        (session/assoc-in! [:movement-session :parts part-number] new-part)))
-                     :error-handler (fn [r] nil)}))
+(defn add-movement-from-search [name part-number]
+  (let [new-movement (get (data/get-movements-map) name)
+        part (session/get-in [:movement-session :parts part-number])
+        new-part (conj part new-movement)]
+    (session/assoc-in! [:movement-session :parts part-number] new-part)))

 (defn inc-set-completed [event m part-number]
   (.preventDefault event)
@@ -286,7 +283,7 @@
                                 :auto-focus  true
                                 :on-save     #(when (some #{%} all-movement-names)
                                                (reset! show-search-input? false)
-                                               ;(add-movement-from-search % part-number)
+                                               (add-movement-from-search % part-number)
                                                )}]))]])))

 (defn part-component []


Fixed bug with urlencoded-form? function

--- src/compojure/http/request.clj
+++ src/compojure/http/request.clj
@@ -56,7 +56,8 @@
 (defn urlencoded-form?
   "Does a request have a urlencoded form?"
   [request]
-  (.startsWith (request :content-type) "application/x-www-form-urlencoded"))
+  (if-let [type (:content-type request)]
+    (.startsWith type "application/x-www-form-urlencoded")))

 (defn get-form-params
   "Parse urlencoded form parameters from the request body."


Readability

Readability

--- agiledox.clj
+++ agiledox.clj
@@ -19,6 +19,8 @@
 (defn as-feature [line]
   (.toLowerCase (.replaceAll line "([A-Z])" " $1")))

+(def empty-line "")
+
 (defn test-lines? [test-file] (not-empty (test-file :lines)))

 (defn make-spec [test-file]
@@ -26,7 +28,7 @@
     (list
       (as-header (test-file :name))
       (map as-feature (test-file :lines))
-      "")))
+      empty-line)))

 (dorun
   (map (fn [s] (if s (println s)))


fixes test failures in Clojure 1.3

fixes test failures in Clojure 1.3

--- test/clj_pail/core_test.clj
+++ test/clj_pail/core_test.clj
@@ -1,6 +1,6 @@
 (ns clj-pail.core-test
-  (:require [clj-pail.core :as pail]
-            [midje.sweet :refer :all])
+  (:require [clj-pail.core :as pail])
+  (:use midje.sweet)
   (:import (com.backtype.hadoop.pail PailSpec PailStructure)))

@@ -13,5 +13,5 @@
 (facts "spec"
   (let [structure (proxy [PailStructure] [])]
     (fact "creates a PailSpec from a PailStructure"
-      (pail/spec structure) => (instance-of PailSpec)
+      (pail/spec structure) => (instance-of PailSpec )
       (.getStructure (pail/spec structure)) => structure)))


Makes Chris happy

Makes Chris happy

--- umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2/spatial.clj
+++ umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2/spatial.clj
@@ -64,7 +64,7 @@
 (defn- shape-el?
   "Returns true if XML element is (probably) a shape instead of other geographic information elements."
   [el]
-  (not (seq (select el "gmd:EX_GeographicDescription"))))
+  (empty? (select el "gmd:EX_GeographicDescription")))

 (defn parse-geometry
   "Returns UMM GeometryType map from ISO XML document."


azulenoids.clj: the walk function uses reduce; new function chain-end.

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -4,9 +4,17 @@
            (org.gavrog.joss.dsyms.generators CombineTiles DefineBranching2d)))

 (defn walk [ds D & idxs]
-  (if (empty? idxs)
-    D
-    (recur ds (.op ds (first idxs) D) (rest idxs))))
+  (reduce (fn [D i] (.op ds i D)) D idxs))
+
+(defn chain-end [ds D i j]
+  (let [step (fn [E]
+               (let [E* (walk ds E j)]
+                 (cond
+                   (nil? E*) E
+                   (= E E*) E
+                   (= D E*) nil
+                   :else (recur (walk ds E j i)))))]
+    (step (walk ds D i))))

 (defn max-curvature [ds]
   (let [dsx (.clone ds)]


show a max of 16 (and never more than the current number of players) on matchup

--- src/foosball/views/matchup.clj
+++ src/foosball/views/matchup.clj
@@ -8,15 +8,16 @@
   (:use [taoensso.timbre :only [trace debug info warn error fatal spy]]))

 (defn- players-select [players selected]
-  [:div.row
-   [:div.control-group
-    [:select {:id "playerids" :name "playerids[]" :multiple "multiple" :size "8"}
-     (->> players
-          (map (fn [{:keys [id name]}]
-                 [:option (merge {:value id}
-                                 (when (contains? selected id) {:selected "selected"}))
-                  name])))]
-    [:span.help-inline "Select atleast four players"]]])
+  (let [number-of-players-to-show (min 16 (count players))]
+    [:div.row
+     [:div.control-group
+      [:select {:id "playerids" :name "playerids[]" :multiple "multiple" :size number-of-players-to-show}
+       (->> players
+            (map (fn [{:keys [id name]}]
+                   [:option (merge {:value id}
+                                   (when (contains? selected id) {:selected "selected"}))
+                    name])))]
+      [:span.help-inline "Select atleast four players"]]]))

 (defn- format-matchup-percentage [p]
   (format-value p


oops!

oops!

--- src/instantetymonline/core.clj
+++ src/instantetymonline/core.clj
@@ -1 +1,91 @@
+(ns instantetymonline.core
+  (:require [net.cgrand.enlive-html :as html]))
+
+(defn gen-url [letter page]
+  (str "http://etymonline.com/index.php?l=" letter "&p=" page))
+
+(defn fetch-url [url]
+  (html/html-resource (java.net.URL. url)))
+
+;; TODO: Add back verb/noun info.
+;; TODO: Keep "Ellis Island" (right now it's turned into "Ellis").
+(defn etym-words [hnodes]
+  (let [raw (map html/text (html/select hnodes [:dt :a]))
+        text (remove empty? raw)]
+    text
+    #_(map #(first (clojure.string/split % #" "))
+         text)))
+
+;; TODO: Use links with cross-references from here.
+(defn etym-links [hnodes]
+  (map html/text (html/select hnodes [:dd.highlight :a])))
+
+(defn etym-descriptions [hnodes]
+  (map html/text (html/select hnodes [:dd])))
+
+(defn etyms [hnodes]
+  (zipmap (etym-words hnodes)
+          (etym-descriptions hnodes)))
+
+;; Scraping
+
+(def letter-page-map
+  {"a" 60
+   "b" 53
+   "c" 84
+   "d" 46
+   "e" 38
+   "f" 42
+   "g" 35
+   "h" 41
+   "i" 38
+   "j" 10
+   "k" 9
+   "l" 31
+   "m" 56
+   "n" 20
+   "o" 22
+   "p" 81
+   "q" 6
+   "r" 46
+   "s" 108
+   "t" 46
+   "u" 24
+   "v" 15
+   "w" 22
+   "x" 1
+   "y" 4
+   "z" 3})
+
+(defn save-html! [letter page]
+  (let [content (fetch-url (gen-url letter page))]
+    (do (spit (str "raw_html/" letter page) (pr-str content))
+        (println "saved" letter page))))
+
+(defn read-html [letter page]
+  (read-string (slurp (str "raw_html/" letter page))))
+
+(defn persist-letter! [letter]
+  (dotimes [n (get letter-page-map letter)]
+    (save-html! letter (str n))))
+
+(defonce words (atom {}))
+
+(defn html->etyms []
+  (doseq [char (keys letter-page-map)] ;; the alphabet
+    (dotimes [n (get letter-page-map char)]
+      (do (swap! words #(merge % (etyms (read-html char (str n)))))
           (println "read into atom" char (str n))))))
+
+(comment
+  ;; Ran this for all letters on October 24, 2015
+  ;;(persist-letter! "a")
+
+  ;; To read it into mem, then save and merge with dict map
+  (etyms (read-html "y" "1"))
+
+  (html->etyms)
+  (first @words)
+
+  (spit "src/dict2.cljs" @words)
+  )


add some type hints

add some type hints

--- dada-core/src/test/clojure/org/dada/core/test_SimpleModelView.clj
+++ dada-core/src/test/clojure/org/dada/core/test_SimpleModelView.clj
@@ -5,7 +5,7 @@
    [org.dada core]
    )
   (:import
-   [org.dada.core Data SimpleModelView Update]
+   [org.dada.core Data Model SimpleModelView Update]
    )
   )

@@ -13,7 +13,7 @@

 (deftest test-simple-model-view

-  (def account-model  (model "Accounts" (seq-metadata 3))) ;; id, version, name
+  (def ^Model account-model  (model "Accounts" (seq-metadata 3))) ;; id, version, name

   (is (= (get-mutable account-model) [{} {} {}]))


Removing interop call to Pattern

Removing interop call to Pattern

--- src/kixi/datastore/transit.clj
+++ src/kixi/datastore/transit.clj
@@ -8,7 +8,7 @@
   {:handlers {Pattern (transit/write-handler "java.util.regex.Pattern" str)}})

 (def read-handlers
-  {:handlers {"java.util.regex.Pattern" (transit/read-handler #(Pattern/compile %))}})
+  {:handlers {"java.util.regex.Pattern" (transit/read-handler #(re-pattern %))}})

 (defn clj-form->json-str
   [clj]


Typo.

Typo.

--- src/oc/storage/api/entries.clj
+++ src/oc/storage/api/entries.clj
@@ -123,7 +123,7 @@
             updated-entry (:updated-entry ctx)
             publish-result (entry-res/publish-entry! conn (:uuid updated-entry) updated-entry user)]
     (do
-      (timbre/info "Published entry for:" (:uuid entry))
+      (timbre/info "Published entry for:" (:uuid updated-entry))
       (change/send-trigger! (change/->trigger :add publish-result))
       (timbre/info "Published entry:" entry-for)
       {:updated-entry publish-result})


RESTful pay action

RESTful pay action

--- src/ombs/handler/eventacts.clj
+++ src/ombs/handler/eventacts.clj
@@ -5,6 +5,7 @@
     [ombs.db.payment :as dbpay]
     [ombs.validate :as isvalid]
     [ombs.funcs :refer [parse-int]]
+    [cheshire.core :as json]
     [noir.session :as sess]
     ))

@@ -17,7 +18,11 @@
         uid (db/get-uid uname)
         parts (parse-int parts)]
     (if (isvalid/ids? eid uid)
-      (dbpay/create-fee uid eid parts))))
+      (do
+        (dbpay/create-fee uid eid parts)
+        (json/generate-string {:ok "Waiting confirmation..."}))
+      (json/generate-string {:error (isvalid/errors-string)})
+      )))

 (defn participate [{eid :eid ename :event-name date :date :as params}]
   "Add participation of current user and selected event(given as param from


require clojure.edn

require clojure.edn

--- src/onyx/compression/nippy.clj
+++ src/onyx/compression/nippy.clj
@@ -1,6 +1,7 @@
 (ns onyx.compression.nippy
   (:require [taoensso.nippy :as nippy]
-            [schema.utils :as su])
+            [schema.utils :as su]
+            [clojure.edn])
   (:import [schema.utils ValidationError NamedError]))

 (nippy/extend-freeze clojure.lang.ExceptionInfo :onyx/exception-info


Add a bass note beneath the chords.

Add a bass note beneath the chords.

--- src/overtunes/songs/before.clj
+++ src/overtunes/songs/before.clj
@@ -2,6 +2,17 @@
   (:use [overtone.live])
   (:use [overtunes.instruments.organ-cornet])
 )
+
+(def starting-section [
+  (chord :Eb3 :major)
+  (chord :Eb3 :major)
+  (chord :C3  :minor7)
+  (chord :C3  :minor7)
+  (chord :Eb3 :major)
+  (chord :Eb3 :major)
+  (chord :C3  :minor7)
+  (chord :C3  :minor7)
+])

 (def middle-section [
   (chord :G3  :minor)
@@ -12,17 +23,6 @@
   (chord :Eb4 :major)
   (chord :Bb3 :major)
   (chord :Bb3 :major)
-])
-
-(def starting-section [
-  (chord :Eb3 :major)
-  (chord :Eb3 :major)
-  (chord :C3  :minor)
-  (chord :C3  :minor)
-  (chord :Eb3 :major)
-  (chord :Eb3 :major)
-  (chord :C3  :minor)
-  (chord :C3  :minor)
 ])

 (def variation-section [
@@ -44,14 +44,19 @@
   (chord :Bb3 :major)
 ])

+
 (defn play-chord [notes duration] ( do
-  (defn play-note [note] (organ-cornet note (/ duration 1000)))
-  (mix
-    (map play-note (map midi->hz notes))
+  (defn play-note [note] (organ-cornet note (/ duration (* 1000 0.9))))
+  (let [
+    root (first notes)
+    bass (- root 12)
+    with-bass (cons bass notes)
+  ]
+    (mix (map play-note (map midi->hz with-bass)))
   )
 ))

-(def metro (metronome 200))
+(def metro (metronome 250))
 (defn beat-length [metro] (- (metro 1) (metro 0)))

 (defn play-progression [progression metro start] ( do
@@ -62,10 +67,13 @@
 ))

 (defn play [] (
-  (play-progression (concat
-    starting-section
-    middle-section
-    variation-section
+  (play-progression
+    (concat
+      starting-section
+      middle-section
+      variation-section
+    )
+    metro
+    (metro)
   )
-  metro (metro))
 ))


Finishes the first exercise for day three of Clojure.

--- Clojure/seven_lang/src/seven_lang/daythree.clj
+++ Clojure/seven_lang/src/seven_lang/daythree.clj
@@ -6,14 +6,19 @@

 (defn credit-account
   [account amount]
-    (dosync
-      (alter (get accounts account) + amount))
+  (dosync
+    (alter accounts
+      #(assoc %1 account (+ (get %1 account) amount))
+      )
+    )
   )

 (defn debit-account
   [account amount]
   (dosync
-    (alter (get accounts account) - amount)
+    (alter accounts
+      #(assoc %1 account (- (get %1 account) amount))
+      )
     )
   )

@@ -35,5 +40,4 @@
   (println accounts)
   )

-
 ;exercise two - the sleeping barber problem


fix test executor

fix test executor

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -295,16 +295,16 @@
                              :done true)
                             test))))]

-    (doseq [[priority test-agents] (sort-by first (group-by (comp :priority deref) test-agents))
-            :let [count-down (atom (count test-agents))
+    (doseq [[priority agents] (sort-by first (group-by (comp :priority deref) test-agents))
+            :let [count-down (atom (count agents))
                   p (promise)]]
       (add-watch count-down :key (fn [k r o n]
                                    (when (zero? n)
                                      (log/info "execution complete!")
                                      (deliver p :done))))
-      (doseq [a test-agents i (:deps @a)]
-        (add-watch (nth test-agents i) [(:id @a) i] (fn [k r o n] (send-off a exec-test))))
-      (doseq [a test-agents]
+      (doseq [a agents dep (:deps @a)]
+        (add-watch (nth test-agents dep) [(:id @a) dep] (fn [k r o n] (send-off a exec-test))))
+      (doseq [a agents]
         (add-watch a [(:id @a)]
                    (fn [k r o n] (when (and (:done n) (not (:done o)))
                                    (swap! count-down dec)


Fixes #53: check for spaces near `=` in param assign.

--- src/selmer/util.clj
+++ src/selmer/util.clj
@@ -47,8 +47,13 @@
 (def ^:dynamic ^Pattern   *endblock-pattern* nil)

 (defn check-tag-args [args]
-  (if (even? (count (filter #{\"} args)))
-    args (exception "malformed tag arguments in " args)))
+  (cond
+    (or (.contains args "= ") (.contains args " ="))
+    (exception "there shouldn't be spaces near `=` in param assign statement: " args)
+
+    (odd? (count (filter #{\"} args)))
+    (exception "malformed tag arguments in " args)
+    :else args))

 (defn read-tag-info [rdr]
   (let [buf (StringBuilder.)