versuch ++

versuch ++

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -23,9 +23,9 @@

 (defn sqlquery [name empfaenger]
   (jdbc/execute! mysql-db ["insert into transaktionen_geberkonten2nehmerkonten (betrag) select MIN(geberkonten.stand) from geberkonten where geberkonten.nr in ( ? , '00000000-0000-0000-0000-00000025')" name])
-  (jdbc/execute! mysql-db ["update transaktionen_geberkonten2nehmerkonten set betrag = betrag * (update geberkonten set stand = stand - 25 where geberkonten.nr = ? AND stand > 0) where sender=?" name name])
+  (jdbc/execute! mysql-db ["update transaktionen_geberkonten2nehmerkonten set betrag = betrag * (select count(*) from geberkonten where geberkonten.nr = ? AND stand > 0) where sender=?" name name])
   (jdbc/update! mysql-db :transaktionen_geberkonten2nehmerkonten {:sender name, :empfaenger empfaenger, :valid 0} (sql/where {:valid 1}))
- ; (jdbc/execute! mysql-db ["update geberkonten set stand = stand - 25 where geberkonten.nr = ? AND stand > 0" name])
+  (jdbc/execute! mysql-db ["update geberkonten set stand = stand - 25 where geberkonten.nr = ? AND stand > 0" name])
 )


port 5000

port 5000

--- src/clj/scrabble/api.clj
+++ src/clj/scrabble/api.clj
@@ -45,5 +45,5 @@
   (wrap-json-response app-routes api-defaults))

 (defn -main [& [port]]
-  (let [port (Integer. (or port 3000))]
+  (let [port (Integer. (or port 5000))]
     (jetty/run-jetty (site #'app) {:port port :join? false})))


[spec] sample data passing spec

[spec] sample data passing spec

--- src/clj_dstream/core.clj
+++ src/clj_dstream/core.clj
@@ -8,8 +8,14 @@
   [& args]
   (println "Hello, World!"))

+;;;TODO thought i needed to spec these "enums" for spec, but doesnt make it work
+;(s/def ::dense string?)
+;(s/def ::sparse string?)
+;(s/def ::transitional string?)
+;(s/def ::sporadic string?)
+;(s/def ::normal string?)

-
+(s/def ::cluster-label (s/or :string string? :nil nil?))

 (s/def ::label #{::dense ::sparse ::transitional})

@@ -17,33 +23,44 @@

 (s/def ::value float?)

-(s/def ::time int?)
-
 (s/def ::dimensions pos-int?)

-(s/def ::position (s/and vector? #(= ::dimensions (count %))))
+(s/def ::position-value (s/and vector?
+                               ;#(= ::dimensions (count %))
+                               ;#(doseq [v %] (float? v))
+                               ))

+(s/def ::position-index (s/and vector?
+                               ;#(= ::dimensions (count %))
+                               ;#(doseq [v %] (int? v))
+                               ))
 (s/def ::domain-start float?)
 (s/def ::domain-end float?)
 (s/def ::domain-interval (s/and float? pos?))
 (s/def ::domain (s/keys :req [::domain-start ::domain-end ::domain-interval]))
 (s/def ::domains (s/coll-of ::domain))

+(s/def ::t int?)
+
 (s/def ::time-point (s/keys :req [::t
                                   ::value
                                   ::status
-                                  ::label]
-                            :opt [::cluster]))
+                                  ::label
+                                  ::cluster-label]))

 (s/def ::time-points (s/coll-of ::time-point))

-(s/def ::cluster (s/coll-of ::grid-cell))
-
-(s/def ::clusters (s/coll-of ::cluster))
-
-(s/def ::grid-cell (s/keys :req [::position ::time-points]))
+(s/def ::grid-cell (s/keys :req [::position-value ::position-index ::time-points]))

 (s/def ::grid-cells (s/coll-of ::grid-cell))
+
+(s/def ::gap_time pos-int?)
+
+(s/def ::beta float?)
+(s/def ::lambda float?)
+(s/def ::c_l float?)
+(s/def ::c_m float?)
+

 (s/def ::properties (s/keys :req [::c_m
                                   ::c_l
@@ -55,21 +72,53 @@

 (s/def ::initialized-clusters boolean?)

-(s/def ::state (s/keys :req [::clusters
-                             ::grid-cells
+(s/def ::state (s/keys :req [::grid-cells
                              ::properties
                              ::initialized-clusters]))

-;;TODO create an fdef and instrument to register specs
+(s/def ::raw-data (s/keys :req [::value ::position-value]))

-(defn dstream [{:keys [::state]}]
-  ;(println (s/explain ::state state))
-  state
-  )
+(def test-state
+  {::grid-cells           [{::position-value [0.1 1.0 2.0 3.0]
+                            ::position-index [0 1 2 3]
+                            ::time-points    [{::t             0
+                                            ::value         0.1
+                                            ::status        ::sporadic
+                                            ::label         ::dense
+                                            ::cluster-label "C0"}]}]
+   ::properties           {::c_m        0.1
+                           ::c_l        0.2
+                           ::lambda     0.99
+                           ::beta       0.223
+                           ::dimensions 4
+                           ::domains    [
+                                         {::domain-start    -1.0
+                                          ::domain-end      1.0
+                                          ::domain-interval 0.1}
+                                         {::domain-start    -1.0
+                                          ::domain-end      1.0
+                                          ::domain-interval 0.1}
+                                         {::domain-start    -1.0
+                                          ::domain-end      1.0
+                                          ::domain-interval 0.1}
+                                         {::domain-start    -1.0
+                                          ::domain-end      1.0
+                                          ::domain-interval 0.1}]
+                           ::gap_time   4}
+   ::initialized-clusters true})

-(s/fdef dstream
-        :args ::state
-        :ret ::state)
+(def test-raw-data
+  {::value          0.1
+   ::position-value [5.0 5.0 5.0 5.0]})

-(stest/instrument `dstream)
+(defn one-dstream-iteration [{:keys [::state ::raw-data]}]
+  state)
+
+(s/fdef one-dstream-iteration
+        :args (s/cat :u (s/keys :req [::state ::raw-data]))
+        :ret (s/keys :req [::state]))
+
+(stest/instrument `one-dstream-iteration)
+
+(clojure.pprint/pprint (one-dstream-iteration {::state test-state ::raw-data test-raw-data}))


refine logic for finding commodity in import

--- src/clj_money/import.clj
+++ src/clj_money/import.clj
@@ -27,7 +27,9 @@
   [context {:keys [exchange symbol]}]
   (->> context
        :commodities
-       (filter #(= (:symbol %) symbol))
+       (filter #(and (= (:symbol %) symbol)
+                     (or (= :iso4217 exchange)
+                         (= (:exchange %) exchange))))
        first))

 (defn- import-account


remove atom from import process

remove atom from import process

--- src/clj_money/import.clj
+++ src/clj_money/import.clj
@@ -218,31 +218,33 @@
   the progress is updated."
   [context record]
   (let [{:keys [record-type ignore?]} (meta record)]
-    (swap! context #(cond-> %
-                      (not ignore?)
-                      (import-record record)
-
-                      (report-progress? record-type)
-                      (inc-and-update-progress record-type)))))
+    (cond-> context
+      (not ignore?)
+      (import-record record)
+
+      (report-progress? record-type)
+      (inc-and-update-progress record-type))))

 (defn import-data
   "Reads the contents from the specified input and saves
   the information using the specified storage. If an entity
   with the specified name is found, it is used, otherwise it
   is created"
-  [storage-spec impt progress-callback]
+  [storage-spec import-spec progress-callback]
   (with-transacted-storage [s storage-spec]
-    (let [user (users/find-by-id s (:user-id impt))
-          context  (atom {:storage s
-                          :import impt
-                          :callback progress-callback
-                          :progress {}
-                          :accounts {}
-                          :entity (entities/find-or-create s
-                                                           user
-                                                           (:entity-name impt))})
-          [inputs source-type] (prepare-input s (:image-ids impt))]
-      (transactions/with-delayed-balancing s (-> @context :entity :id)
-        (doseq [record (mapcat #(read-source source-type %) inputs)]
-          (process-record context record)))
-      (:entity @context))))
+    (let [user (users/find-by-id s (:user-id import-spec))
+          [inputs source-type] (prepare-input s (:image-ids import-spec))
+          entity (entities/find-or-create s
+                                          user
+                                          (:entity-name import-spec))
+          result (transactions/with-delayed-balancing s (:id entity)
+                   (->> inputs
+                        (mapcat #(read-source source-type %))
+                        (reduce process-record
+                                {:storage s
+                                 :import import-spec
+                                 :callback progress-callback
+                                 :progress {}
+                                 :accounts {}
+                                 :entity entity})))]
+      entity)))


cleanup

cleanup

--- src/cljs/ufo/client.cljs
+++ src/cljs/ufo/client.cljs
@@ -75,7 +75,6 @@
          qval (or val
                   (first
                    (:query (om/get-params this))))]
-     (println "(om/get-params this)" (om/get-params this))
      (let [{fname :fname lname :lname} results
            set-query-fn!
            ;; {:params {:query <val>}} - <val> must be vector otherwise I get:


[neko.log] Use pr-str to format log output

--- src/clojure/neko/log.clj
+++ src/clojure/neko/log.clj
@@ -31,10 +31,10 @@
           {:keys [exception tag]} (if (odd? (count kwargs))
                                     (butlast kwargs)
                                     kwargs)
-          tag (or tag (str *ns*))]
-      (if exception
-        `(. Log ~logfn ~tag (apply str (interpose " " [~@strings])) ~exception)
-        `(. Log ~logfn ~tag (apply str (interpose " " [~@strings])))))))
+          tag (or tag (str *ns*))
+          ex-form (if exception [exception] ())]
+      `(binding [*print-readably* nil]
+         (. Log ~logfn ~tag (pr-str ~@strings) ~@ex-form)))))

 (defmacro e
   "Log an ERROR message, applying pr-str to all the arguments and taking


Add reproductive-convergence meta-error

Add reproductive-convergence meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -205,6 +205,16 @@
                           (if (and (:parent1-genome ind) (:parent2-genome ind))
                             (max (sequence-similarity (:genome ind) (:parent1-genome ind))
                                  (sequence-similarity (:genome ind) (:parent2-genome ind)))
+                            1.0)
+                          ;
+                          (= cat :reproductive-convergence)
+                          (if (and (:parent1-genome ind) (:parent2-genome ind))
+                            (let [g (:genome ind)
+                                  child1-genome (produce-child-genome-by-autoconstruction g g argmap)
+                                  child2-genome (produce-child-genome-by-autoconstruction g g argmap)]
+                              (max (sequence-similarity g child1-genome)
+                                   (sequence-similarity g child2-genome)
+                                   (sequence-similarity child1-genome child2-genome)))
                             1.0)
                           :else (throw (Exception. (str "Unrecognized meta category: " cat)))))]
     (vec (flatten (mapv meta-error-fn meta-error-categories)))))


watch all keys

watch all keys

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9395 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/view.clj
+++ plugins/SlideExplorer2/src/slide_explorer/view.clj
@@ -2,7 +2,8 @@
   (:import (javax.swing AbstractAction JComponent JFrame JPanel JLabel KeyStroke)
            (java.awt Color Graphics Graphics2D Rectangle RenderingHints Window)
            (java.util UUID)
-           (java.awt.event ComponentAdapter MouseAdapter WindowAdapter)
+           (java.awt.event ComponentAdapter KeyEvent KeyAdapter
+                           MouseAdapter WindowAdapter)
            (org.micromanager.utils GUIUpdater))
   (:use [org.micromanager.mm :only (edt)]
         [slide-explorer.image :only (crop merge-and-scale overlay lut-object)]))
@@ -42,6 +43,16 @@
   `(let [ret# (time ~expr)]
      (println '~expr)
      ret#))
+
+;; GUI UTILITIES
+
+(defn descendants
+  "Returns a depth-first seq of all components contained by window."
+  [window]
+  (tree-seq (constantly true)
+            #(.getComponents %)
+            window))
+

 ;; TILE <--> PIXELS

@@ -265,6 +276,17 @@
   (bind-window-keys window ["SUBTRACT" "OPEN_BRACKET"]
                    (fn [] (swap! zoom-atom update-in [:zoom] #(max MIN-ZOOM (dec %))))))

+(defn watch-keys [window key-atom]
+  (let [key-adapter (proxy [KeyAdapter] []
+                      (keyPressed [e]
+                                  (swap! key-atom update-in [:keys] conj
+                                         (KeyEvent/getKeyText (.getKeyCode e))))
+                      (keyReleased [e]
+                                   (swap! key-atom update-in [:keys] disj
+                                          (KeyEvent/getKeyText (.getKeyCode e)))))]
+    (doseq [component (descendants window)]
+      (.addKeyListener component key-adapter))))
+
 ;; MAIN WINDOW AND PANEL

 (defn main-panel [screen-state available-tiles]
@@ -281,7 +303,7 @@
     (.setBounds 10 10 500 500)))

 (defn show [available-tiles]
-  (let [screen-state (atom (sorted-map :x 0 :y 0 :z 0 :zoom 0))
+  (let [screen-state (atom (sorted-map :x 0 :y 0 :z 0 :zoom 0 :keys (sorted-set)))
         panel (main-panel screen-state available-tiles)
         frame (main-frame)]
     (def at available-tiles)
@@ -295,6 +317,7 @@
     (handle-wheel panel screen-state)
     (handle-resize panel screen-state)
     (handle-zoom frame screen-state)
+    (watch-keys frame screen-state)
     (display-follow panel screen-state)
     (display-follow panel available-tiles)
     frame))


Bump db version

Bump db version

--- src-clj/acha/db.clj
+++ src-clj/acha/db.clj
@@ -10,7 +10,7 @@
     [acha.achievement-static :as static])
   (:import com.mchange.v2.c3p0.ComboPooledDataSource))

-(def ^:const ^:private db-version "0.2.8")
+(def ^:const ^:private db-version "0.2.9")

 (def ^:private gen-id-key (keyword "last_insert_rowid()"))


Extend set-msg! with custom timeout

Extend set-msg! with custom timeout

The function notifos/set-msg! accepts a :timeout key/value pair in the opts map
to set a custom timeout.

--- src/lt/objs/notifos.cljs
+++ src/lt/objs/notifos.cljs
@@ -26,10 +26,16 @@
             (pr-str m))]
     (object/merge! statusbar/statusbar-loader (merge {:message m :class ""} opts))))

-(defn set-msg! [msg opts]
-  (msg* msg opts)
-  (js/clearTimeout cur-timeout)
-  (set! cur-timeout (wait standard-timeout #(msg* ""))))
+(defn set-msg!
+  ([msg]
+   (msg* msg)
+   (js/clearTimeout cur-timeout)
+   (set! cur-timeout (wait standard-timeout #(msg* ""))))
+  ([msg opts]
+   (msg* msg opts)
+   (js/clearTimeout cur-timeout)
+   (set! cur-timeout (wait (or (:timeout opts)
+                               standard-timeout) #(msg* "")))))

 (cmd/command {:command :reset-working
               :desc "Statusbar: Reset working indicator"


corrected `expect` docstring

corrected `expect` docstring

--- src/midje/semi_sweet.clj
+++ src/midje/semi_sweet.clj
@@ -145,8 +145,8 @@
    results are as expected. If the expected results are a function, it
    will be called with the actual result as its single argument.

-   To strip tests from production code, set either clojure.test/*load-tests*
-   or midje.semi-sweet/*check* to false."
+   To strip tests from production code, set either clojure.test/*load-tests*,
+   midje.semi-sweet/*include-midje-checks*, or midje.sweet/*include-midje-checks* to false."
   [& _]
   (when (user-desires-checking?)
     (valid-let [[call-form arrow expected-result & fakes+overrides] (validate &form)


get security group id

get security group id

--- src/shuppet/aws.clj
+++ src/shuppet/aws.clj
@@ -55,3 +55,9 @@
         response (client/post url { :content-type "application/x-www-form-urlencoded; charset=utf-8" :throw-exceptions false})]
     (prn "Decoded message response = " response)
     response))
+
+(defn security-group-id [group-name]
+  (xml1-> (ec2-request {"Action" "DescribeSecurityGroups"
+                        "Filter.1.Name" "group-name"
+                        "Filter.1.Value" group-name})
+          :securityGroupInfo :item :groupId text))


more card implementations

more card implementations

--- src/node/game/cards.cljs
+++ src/node/game/cards.cljs
@@ -143,6 +143,9 @@
    "Magnum Opus"
    {:abilities [{:cost [:click 1] :effect (effect (gain :credit 2)) :msg "gain 2 [Credits]"}]}

+   "Mandatory Upgrades"
+   {:effect (effect (gain :click 1 :click-per-turn 1))}
+
    "Medical Research Fundraiser"
    {:effect (effect (gain :credit 8) (gain :runner :credit 3))}

@@ -185,6 +188,10 @@

    "Quality Time"
    {:effect (effect (draw 5))}
+
+   "Rachel Beckman"
+   {:effect (effect (gain :click 1 :click-per-turn 1))
+    :leave-play (effect (lose :click 1 :click-per-turn 1))}

    "Restructure"
    {:effect (effect (gain :credit 15))}
@@ -243,6 +250,9 @@
    "Daily Casts"
    {:data {:counter 8}}

+   "Director Haas"
+   {:effect (effect (gain :click 1 :click-per-turn 1)) :leave-play (effect (lose :click-per-turn 1))}
+
    "Exile: Streethawk"
    {:effect (effect (gain :link 1))}

@@ -336,6 +346,10 @@
    "Reina Roja: Freedom Fighter"
    {:effect (effect (gain :link 1))}

+   "Research Station"
+   {:effect (effect (gain :max-hand-size 2))
+    :leave-play (effect (lose :max-hand-size 2))}
+
    "SEA Source"
    {:req (req (:sucessful-run runner-reg))}


WIP: missing finance calcs.

WIP: missing finance calcs.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -117,27 +117,31 @@
         (into [:td]
           (map #(growth-metric % metadata) metrics))]]))

+(defn calc-runway [cash burn-rate]
+  (int (* (/ cash burn-rate) 30)))
+
 (defn- finance-metrics [topic currency]
   (let [finances (last (sort-by :period (:data topic)))
         period (f/parse monthly-period (:period finances))
         date (s/upper-case (f/unparse monthly-date period))
         cash? (:cash finances)
+        cash (:cash finances)
         revenue? (:revenue finances)
+        revenue (:revenue finances)
         costs? (:costs finances)
+        costs (:costs finances)
         cash-flow? (and revenue? costs?)
-        burn-rate? (and cash? (or costs? cash-flow?))]
+        cash-flow (- revenue costs)
+        runway? (and cash? costs? (or (not revenue?) (> costs revenue)))
+        runway (when runway? (calc-runway cash cash-flow))]
     [:table {:class "finances-metrics"}
       [:tr
         [:td
-          (when cash? (metric (str "CASH - " date) (:cash finances) "$")) ; TODO other currencies
-          (when revenue? (metric (str "REVENUE - " date) (:revenue finances) "$")) ; TODO other currencies
-          (when costs? (metric (str "COSTS - " date) (:costs finances) "$")) ; TODO other currencies
-          (when (or cash-flow? burn-rate?)
-            (if cash-flow?
-              (metric (str "CASH FLOW - " date) 25 "$") ; TODO other currencies
-              (metric (str "BURN RATE - " date) 50 "$"))) ; TODO other currenciesk
-          (when (and cash? burn-rate?)
-            (metric (str "RUNWAY - " date) "1 year"))]]]))
+          (when cash? (metric (str "CASH - " date) cash "$")) ; TODO other currencies
+          (when revenue? (metric (str "REVENUE - " date) revenue "$")) ; TODO other currencies
+          (when costs? (metric (str "COSTS - " date) costs "$")) ; TODO other currencies
+          (when cash-flow? (metric (str "CASH FLOW - " date) cash-flow "$")) ; TODO other currencies
+          (when runway? (metric (str "RUNWAY - " date) runway))]]]))

 (defn- data-topic [snapshot topic-name topic topic-url]
   (let [currency (:currency snapshot)
@@ -294,4 +298,8 @@
   (def snapshot (json/decode (slurp "./opt/samples/green-labs.json")))
   (spit "./hiccup.html" (content/html (-> snapshot (assoc :note note) (assoc :company-slug "green-labs"))))

+  (def note "Hi all, here’s the latest info. Recruiting efforts paid off! Retention is down though, we’ll fix it. Let me know if you want to discuss before we meet next week.")
+  (def snapshot (json/decode (slurp "./opt/samples/buffer.json")))
+  (spit "./hiccup.html" (content/html (-> snapshot (assoc :note note) (assoc :company-slug "green-labs"))))
+
   )


A more readable validation unfolder

A more readable validation unfolder

--- src/themis/core.clj
+++ src/themis/core.clj
@@ -129,8 +129,8 @@
     and remove `nil` results"
     [themis-result-map]
     (reduce (fn [old [k-vec value]]
-              (let [validation-value (keep identity value)
-                    seqd-value (seq validation-value)] ;;remove nils if a seq
+              (let [validation-value (remove nil? value)
+                    seqd-value (not-empty validation-value)]
                 (if seqd-value
                   (assoc-in old k-vec
                             (if (sequential? value)


Reuse Cursor schema

Reuse Cursor schema

--- src/om_tools/schema.cljs
+++ src/om_tools/schema.cljs
@@ -10,4 +10,4 @@
 (defn cursor
   "Returns a schema to validate an Om cursor"
   [schema]
-  (s/both (s/pred om/cursor?) schema))
+  (s/both Cursor schema))


fixed util.clj

fixed util.clj

--- src/atom_finder/util.clj
+++ src/atom_finder/util.clj
@@ -9,6 +9,25 @@
            [org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTProblemStatement CPPASTConditionalExpression CPPASTExpressionList]
            [org.eclipse.cdt.internal.core.parser.scanner ASTFileLocation]
            [org.eclipse.cdt.internal.core.dom.rewrite.astwriter ASTWriter]))
+
+(s/set-fn-validation! true) ; Globally turn on schema validation
+
+(defn load-cljs-in-dir
+  [dir] ; e.g. "classifier/"
+  (->> dir
+       (str "atom_finder/")
+       ClassLoader/getSystemResource
+       clojure.java.io/file
+       file-seq
+       sort
+       (map (memfn getName))
+       (filter #(str/ends-with? % ".clj"))
+       (map #(str/replace % #"\.clj$" ""))
+       (map (partial str dir))
+       (apply load)
+  ))
+
+(load-cljs-in-dir "util/")

 ;;Note: Operators missing from the list: (scope/ resolution ::) (memory allocation/ new new[] delete delete[]) (pointer-to-member/ ->* .*)
 (defmulti precedence-level "returns the precedence level of the node" class)
@@ -76,539 +95,3 @@
         #{IASTBinaryExpression/op_assign IASTBinaryExpression/op_binaryAndAssign IASTBinaryExpression/op_binaryOrAssign IASTBinaryExpression/op_binaryXorAssign IASTBinaryExpression/op_divideAssign IASTBinaryExpression/op_minusAssign IASTBinaryExpression/op_moduloAssign IASTBinaryExpression/op_multiplyAssign IASTBinaryExpression/op_plusAssign IASTBinaryExpression/op_shiftLeftAssign IASTBinaryExpression/op_shiftRightAssign}]

     (and (instance? IASTBinaryExpression node) (contains? assignment-list (.getOperator node)))))
-
-(defn pmap-dir-nodes
-  "Apply a function to the AST of every c file in a directory"
-  [f dirname]
-          (pmap
-           (fn [file]
-             (let [filename (.getPath file)]
-               (try
-                 (f (parse-file filename))
-                 (catch Exception e (printf "-- exception parsing file: \"%s\"\n" filename))
-                 (catch Error e     (printf "-- error parsing file: \"%s\"\n" filename))
-               )
-             ))
-
-           (c-files dirname)))
-
-   [org.eclipse.cdt.core.dom.ast gnu.cpp.GPPLanguage cpp.ICPPASTNamespaceDefinition
-    IASTCompositeTypeSpecifier ASTVisitor IASTNode IASTProblemStatement IASTName
-    IASTBinaryExpression IASTProblem IASTProblemHolder]
-   [org.eclipse.cdt.core.parser DefaultLogService FileContent IncludeFileContentProvider ScannerInfo]
-   [org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTProblemStatement]
-   [org.eclipse.cdt.internal.core.parser.scanner ASTFileLocation]))
-
-(s/set-fn-validation! true) ; Globally turn on schema validation
-
-(defn load-cljs-in-dir
-  [dir] ; e.g. "classifier/"
-  (->> dir
-       (str "atom_finder/")
-       ClassLoader/getSystemResource
-       clojure.java.io/file
-       file-seq
-       sort
-       (map (memfn getName))
-       (filter #(str/ends-with? % ".clj"))
-       (map #(str/replace % #"\.clj$" ""))
-       (map (partial str dir))
-       (apply load)
-  ))
-
-(load-cljs-in-dir "util/")
-
-
-;;
-;;
-;;      NOTE
-;;      THE FOLLOWING FUNCTIONS WERE USED IN THE OLD UTIL.CLJ
-;;
-;;
-(comment
-
- ;;;;;;
-;;;   Completely generic utilities
-;;;;;;
-
-;; print methods of java object
-;; http://stackoverflow.com/questions/5821286/how-can-i-get-the-methods-of-a-java-class-from-clojure
-(defn java-methods
-  "list methods of java object"
-  [obj]
-  (->> obj
-       r/reflect
-       (:members)
-       ;(filter :exception-types)
-       (map #(dissoc % :exception-types))
-       (map #(dissoc % :declaring-class))
-       (sort-by :name)
-       ))
-
-(defn public-methods
-  "list public methods of java object"
-  [obj]
-  (->> obj
-       (java-methods)
-       (filter #(:public (:flags %)))
-       ))
-
-(defn ppublic-methods
-  "print public methods of java object"
-  [obj]
-  (->> obj
-       (public-methods)
-       (print-table)
-       ))
-
-(defn errln [& s]
-  (binding [*out* *err*]
-      (println (apply str s))))
-
-(defmacro %w [& words]
-    `(list ~@(map str (vec words))))
-
-(defn tap [f x] (f x) x)
-(defn pap [x] (tap prn x)) ; print the value of variable and return it
-
-(defmacro =by
-  "Test if arguments are equal after applying f to all of them"
-  [f & args]
-  `(= ~@(map #(list f %) args)))
-
-; print the name and value of an expression
-(defmacro pprn [x]
-  `(let [y# ~x]
-    (do
-      (print (str ~(str x ": ") (prn-str y#)))
-      y#)))
-
-(def not-empty? (comp not empty?))
-
-(defn sym-diff
-  "Set symmetric difference - the opposite of the intersection"
-  [& args]
-  (clojure.set/difference
-   (apply clojure.set/union args)
-   (apply clojure.set/intersection args)))
-
-(def any-pred? (comp boolean some))
-(defn exists?
-  ([lst] (any-pred? true? lst))
-  ([pred lst] (any-pred? pred lst)))
-
-(def range-from (partial iterate inc))
-
-(defn distinct-by [f col]
-  (map first (vals (group-by f col))))
-
-(defn map-values [f m]
-  (reduce merge (map (fn [[k v]] {k (f v)}) m)))
-
-(def transpose (partial apply map vector))
-
-(defn slurp-lines [file]
-    (str/split-lines (slurp file)))
-
-(defn count-lines [str]
-    (count (filter #{\newline} str)))
-
-(defn line-range [min max s]
-  "return the line of a string between [min max)"
-  (->> s str/split-lines
-       (drop (dec min))
-       (take (- max min))))
-
-(defn close?
-  "Are two numbers approximately equal"
-  [tolerance x y]
-     (< (Math/abs (- x y)) tolerance))
-
-(defn strict-get
-  "Lookup value in collection and throw exception if it doesn't exist"
-  [m k]
-  (if-let [[k v] (find m k)]
-    v
-        (throw (Exception. (str "Key Not Found " k)))))
-
-; http://stackoverflow.com/questions/43213573/get-in-for-lists/43214175#43214175
-(defn get-nth-in [init ks]
-  (reduce
-   (fn [a k]
-     (if (associative? a)
-       (get a k)
-       (nth a k)))
-   init ks))
-
-; https://crossclj.info/ns/logicadb/0.1.0/com.kurogitsune.logicadb.core.html#_safe-nth
-(defn safe-nth [x n] (try (nth x n) (catch Exception e nil)))
-
-(def flatten1 (partial apply concat))
-
-(defn avg [seq1] (/ (reduce + seq1) (count seq1)))
-
-(defn min-of [lst]
-  "Min with a list argument"
-  (if (empty? lst) nil
-    (apply min lst)))
-
-(defn max-of [lst]
-  "Max with a list argument"
-  (if (empty? lst) nil
-    (apply max lst)))
-
-(defn group-dissoc
-  "Group a list of maps by a key, then dissoc that key"
-  [key coll]
-  (->> coll (group-by key) (map-values (partial map #(dissoc % key)))))
-
-; https://gist.github.com/sunng87/13700d3356d5514d35ad
-(defn invoke-private-method [obj fn-name-string & args]
-  (let [m (first (filter (fn [x] (.. x getName (equals fn-name-string)))
-                         (.. obj getClass getDeclaredMethods)))]
-    (. m (setAccessible true))
-    (. m (invoke obj args))))
-
-(defn private-field [obj fn-name-string]
-  (let [m (.. obj getClass (getDeclaredField fn-name-string))]
-    (. m (setAccessible true))
-        (. m (get obj))))
-
-;;;;;;;;
-;;   Specific to this project
-;;;;;;;
-
-(defmulti translation-unit class)
-(defmethod translation-unit java.io.File [file] (translation-unit (.getPath file)))
-(defmethod translation-unit String [filename]
-  (let [definedSymbols {}
-        includePaths (make-array String 0)
-        info (new ScannerInfo definedSymbols includePaths)
-        log (new DefaultLogService)
-        emptyIncludes (IncludeFileContentProvider/getEmptyFilesProvider)
-        opts 8]
-
-    (.getASTTranslationUnit (GPPLanguage/getDefault)
-                            (FileContent/createForExternalFileLocation filename)
-                            info emptyIncludes nil opts log)))
-
-(defn mem-tu
-  "Create an AST from in-memory source (name is for documentation only)"
-  [filename source]
-  (let [definedSymbols {}
-        includePaths (make-array String 0)
-        info (new ScannerInfo definedSymbols includePaths)
-        log (new DefaultLogService)
-        emptyIncludes (IncludeFileContentProvider/getEmptyFilesProvider)
-        opts 8]
-
-    (.getASTTranslationUnit (GPPLanguage/getDefault)
-                            (FileContent/create filename (.toCharArray source))
-                            info emptyIncludes nil opts log)))
-
-(defn arg-count [f]
-  (let [m (first (.getDeclaredMethods (class f)))
-        p (.getParameterTypes m)]
-    (alength p)))
-
-
-(defn children    [^IASTNode node] (.getChildren node))
-(defn parent      [^IASTNode node] (.getParent node))
-(defn safe-parent [^IASTNode node] (or (.getParent node) node))
-(defn root-ancestor [^IASTNode node]
-  (let [p (parent node)]
-    (if (nil? p)
-      node
-      (recur p))))
-
-(defn pre-tree
-  ([f node] (pre-tree f node 1))
-  ([f node index]
-
-   (let [kids (children node)
-         ret (case (arg-count f)
-                   1 (f node)
-                   2 (f node index))]
-
-     (conj
-           (doseq [iast-node kids]
-             (pre-tree f iast-node (inc index)))
-           ret))))
-
-(defn print-tree [node]
-  (letfn
-      [(f [node index]
-         (let [offset (format " (offset: %s, %s)"
-                              (-> node .getFileLocation .getNodeOffset)
-                              (-> node .getFileLocation .getNodeLength))]
-
-           (printf "%s -%s %s -> %s\n"
-                   (apply str (repeat index "  "))
-                   (-> node .getClass .getSimpleName)
-                   offset
-                   (-> node .getRawSignature
-                       (str "           ")
-                       (.subSequence 0 10)
-                       (.replaceAll "\n" " \\ ")))))]
-
-    (pre-tree f node)))
-
-(defn depth [node]
-  (inc
-   (apply max 0
-          (map depth
-               (children node)))))
-
-(defn leaf? [node] (empty? (children node)))
-
-(defn leaves [node]
-  (if (leaf? node)
-    node
-    (flatten (map leaves (children node)))))
-
-(def ast-writer (ASTWriter.))
-(defn write-ast [node] (.write ast-writer node))
-
-;; http://stackoverflow.com/questions/23178750/iteratively-apply-function-to-its-result-without-generating-a-seq
-(defn fn-pow
-  [f x n]
-    (nth (iterate f x) n))
-
-; https://gist.github.com/micmarsh/bcbe19c9de8bb7a471bf
-(defn flip [function]
-  (fn
-    ([] (function))
-    ([x] (function x))
-    ([x y] (function y x))
-    ([x y z] (function z y x))
-    ([a b c d] (function d c b a))
-    ([a b c d & rest]
-     (->> rest
-          (concat [a b c d])
-          reverse
-          (apply function)))))
-
-(defn all-parents
-  "Get the all grandparents of the node"
-  [node]
-  (take-while some? (iterate parent node)))
-
-(defn ancestor
-  "Get the nth grandparent of the node"
-  [n node]
-    (fn-pow parent node n))
-
-(defn ancestral-instance?
-  "Check whether any of this nodes ancestry are of the type listed"
-  [type node]
-  (if (nil? node)
-    false
-    (if (instance? type node)
-      true
-      (ancestral-instance? type (parent node)))))
-
-(defn typename [node]
-  (let [name (-> node .getClass .getSimpleName)]
-    (nth (re-find #"AST(.*)" name) 1)))
-
-(defn filter-depth
-  "Return every sub-tree of size n"
-  [n node]
-  ;; start from the leaves of the tree and walk upwards n generations
-  (let [candidates (distinct (map (partial ancestor n) (leaves node)))]
-    ;; candidates may still have deeper branches than the one we came up from
-    (filter #(= n (depth %)) candidates)))
-
-(defn flatten-tree [node]
-  (conj (mapcat flatten-tree (children node)) node))
-
-(defn mapcat-tree [f node]
-  (map f (flatten-tree node)))
-
-(defn filter-tree
-  "Find every AST node that matches pred"
-  [pred node]
-  (->> node flatten-tree (filter pred)))
-
-(defn filter-type
-  "Return every example of type"
-  [type node]
-  (filter-tree #(= (typename %) type) node))
-
-(defn filter-type-parent
-  "Return the parent of each type"
-  [type node]
-  (->> node
-       (filter-type type)
-       (map parent)
-       distinct))
-
-(defn filter-instance
-  [type node]
-  ancestral-instance?
-  (let [kids        (children node)
-        kid-matches (mapcat (partial filter-instance type) kids)
-        matches     (filter (partial instance? type) kids)]
-    (concat matches kid-matches)))
-
-(defn filter-instance-parent
-  "Return the parent of each type"
-  [type node]
-  (->> node
-       (filter-instance type)
-       (map parent)
-       distinct))
-
-(defn count-nodes
-  "Count the size of the ast"
-  [node]
-    (inc (reduce + (map count-nodes (children node)))))
-
-(defn c-files
-  "Search directory structure for C-like files"
-  [dirname]
-  (let [dirfile  (clojure.java.io/file dirname)
-        files (file-seq dirfile)
-        exts #{"c" "cc" "cpp" "c++" "h" "hh" "hpp" "h++"}]
-
-    (filter
-     (fn [file]
-       (and
-        (exts (nth (re-find #".*\.([^.]+)" (.getName file)) 1 nil))
-        (.isFile file))
-       )
-     files)))
-
-(defn resource-path
-  "Find the path to a resource"
-  [filename]
-  (some->> filename clojure.java.io/resource clojure.java.io/file .getPath))
-
-
-(defn get-in-tree
-  "Find a value in the AST by indexes"
-  [indices node]
-  (cond
-    (nil? node) nil
-    (empty? indices) node
-    :else (recur (rest indices) (nth (children node) (first indices) nil))))
-
-(defn expand-home [s]
-  (if (clojure.string/starts-with? s "~")
-    (str/replace-first s "~" (System/getProperty "user.home"))
-        s))
-
-(defn write-tempfile
-  [content]
-  ; https://github.com/clojure-cookbook/clojure-cookbook/blob/master/04_local-io/4-10_using-temp-files.asciidoc
-  (let [my-temp-file (java.io.File/createTempFile "filename" ".txt")]
-    (with-open [file (clojure.java.io/writer my-temp-file)]
-      (binding [*out* file]
-        (print content)))
-
-    my-temp-file))
-
-(defn parse-source
-  "Turn a string of C source code into an AST"
-  [code]
-  (mem-tu "anonymously-parsed-code.c" code))
-
-(defn parse-stmt
-  "Turn a single C statement into an AST"
-  [code]
-  (->> (str "int main() {\n" code "\n}\n")
-      parse-source
-      (get-in-tree [0 2 0])))
-
-(defn parse-expr
-  "Turn a single C expression into an AST"
-  [code]
-  (->> (str code ";")
-      parse-stmt
-      (get-in-tree [0])))
-
-(def parse-file (comp translation-unit expand-home))
-
-(defn parse-resource
-  "Parse a file in the resource directory"
-  [filename]
-  (->> filename resource-path parse-file))
-
-(defn find-after
-  "Take the element after the specified one"
-  [coll elem]
-  (->> (map vector coll (rest coll))
-       (filter #(= elem (first %)))
-       first
-       last))
-
-(def find-first (comp first (partial filter)))
-
-(def map-kv (comp (partial into {}) (partial map)))
-
-; core/org.eclipse.cdt.core/parser/org/eclipse/cdt/internal/core/dom/rewrite/changegenerator/ChangeGenerator.java:getNextSiblingNode(IASTNode node)
-(s/defn next-sibling :- (s/maybe IASTNode)
-  [node :- IASTNode]
-  (let [parent-node (parent node)
-        siblings
-          (condp instance? parent-node
-                ICPPASTNamespaceDefinition (.getDeclarations (cast ICPPASTNamespaceDefinition) true)
-                IASTCompositeTypeSpecifier (.getDeclarations (cast IASTCompositeTypeSpecifier) true)
-                (children parent-node))]
-
-        (find-after siblings node)))
-
-(s/defn stmt-str? :- s/Bool
-  [code :- String]
-  (let [stmt-parse (parse-stmt code)]
-    ; if the code isn't a statement the next node will be a problem statement
-    (and (not (nil? stmt-parse))
-      (not (instance? CPPASTProblemStatement (next-sibling stmt-parse))))
-  ))
-
-(defn parse-frag
-  "Turn a single C fragment (statement or expression) into an AST"
-  [code]
-  (let [parse-stmt-or-expr (fn [code] ((if (stmt-str? code) parse-stmt parse-expr) code))
-        node1 (parse-stmt-or-expr code)]
-    (if (instance? IASTProblemStatement node1)
-      (parse-stmt-or-expr (str code ";"))
-      node1)))
-
-(defmulti loc "Get location information about an AST node" class)
-(defmethod loc ASTFileLocation [l]
-  (let [offset (.getNodeOffset l)
-        length (.getNodeLength l)
-        start-line (.getStartingLineNumber l)
-        end-line  (.getEndingLineNumber l)]
-    {:line start-line :offset offset :length length :start-line start-line :end-line end-line}))
-
-(defmethod loc Object
-  [node]
-  (loc (.getFileLocation node)))
-
-(def offset (comp :offset loc))
-(def start-line (comp :start-line loc))
-(def end-line (comp :end-line loc))
-
-(defn errln "println to stderr" [s]
-  (binding [*out* *err*] (println s)))
-
-(defn all-preprocessor [node] (.getAllPreprocessorStatements (root-ancestor node)))
-
-(defn all-comments [node] (->> node root-ancestor .getComments (into [])))
-
-(defn print-node
-  "Print the line that contains the node and the lines around it"
-  [node]
-  (let [line-num (.getStartingLineNumber (.getFileLocation node)) file-name (.getContainingFilename node)]
-    (with-open [rdr (clojure.java.io/reader file-name)]
-      (let [file-seq (line-seq rdr) total-line-num (count file-seq)]
-       (println "===================================================")
-
-       (if (>= (- line-num 2) 0) (println (str (- line-num 1) "    " (nth file-seq (- line-num 2)))))
-       (println (str line-num ">>>>" (nth file-seq (- line-num 1))))
-       (if (<= line-num total-line-num) (println (str (+ line-num 1) "    " (nth file-seq line-num))))
-
-       (println "===================================================")))))
-  )


don't die if posts have no date

don't die if posts have no date

although we need to think a bit more about how to deal with them properly

--- src/yablog/page.clj
+++ src/yablog/page.clj
@@ -38,10 +38,11 @@
   (or (:title page) (:subject page)))

 (defn url [page]
-  (let [d (:date page)
-        y (time/year d)
-        m (time/month d)]
-    (str "/" y "/" m "/" (slug (title page)))))
+  (if-let [d (:date page)]
+    (let [y (time/year d)
+          m (time/month d)]
+      (str "/" y "/" m "/" (slug (title page))))
+    (slug (title page))))

 (defn read-pages [path]
   (let [names (filter textile? (file-seq (io/file path)))]


Make colorization work

Make colorization work

--- src/pinpointer/core.cljc
+++ src/pinpointer/core.cljc
@@ -6,20 +6,20 @@
             [pinpointer.printer :as printer]
             [pinpointer.trace :as trace]))

-(defn wavy-line [start length]
-  (apply str (concat (repeat start \space)
-                     (repeat length \^))))
-
-(defn default-colorize-fn [s]
-  #?(:clj (clansi/style s :yellow)
+(defn default-colorize-fn [color s]
+  #?(:clj (clansi/style s color)
      :cljs s))

-(defn- colorize-by [colorize-fn s]
-  (if colorize-fn
-    (if (= colorize-fn :ansi)
-      (default-colorize-fn s)
-      (colorize-fn s))
-    s))
+(def ^:dynamic *colorize-fn* default-colorize-fn)
+
+(defn- colorize [color s]
+  (*colorize-fn* color s))
+
+(defn- wavy-line [start length]
+  (->> (concat (repeat start \space)
+               (repeat length \^))
+       (apply str)
+       (colorize :red)))

 (defn- format-data [value trace]
   (let [lines (str/split (printer/pprint-str value trace) #"\n")]
@@ -29,18 +29,22 @@
         (if highlighting?
           (let [indent (count (re-find #"^\s*" line))
                 [highlight post] (str/split line #"\001")
-                wavy (wavy-line indent (count highlight))]
+                wavy (wavy-line indent (count highlight))
+                highlight (colorize :red highlight)]
             (recur more false (conj ret (str highlight post) wavy)))
           (let [[pre highlight] (str/split line #"\000")]
             (if highlight
               (let [[highlight' post] (str/split highlight #"\001")
-                    wavy (wavy-line (count pre) (count highlight'))]
+                    wavy (wavy-line (count pre) (count highlight'))
+                    highlight' (colorize :red highlight')]
                 (recur more (not post)
                        (conj ret (str pre highlight' post) wavy)))
               (recur more highlighting? (conj ret line)))))))))

 (defn- hline []
-  (println "\n --------------------------------------------------\n"))
+  (->> "\n --------------------------------------------------\n"
+       (colorize :cyan)
+       println))

 (defn pinpoint-out
   ([ed] (pinpoint-out ed {}))


Added marking nodes in the lattice diagram

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

--- src/conexp/contrib/draw/nodes_and_connections.clj
+++ src/conexp/contrib/draw/nodes_and_connections.clj
@@ -26,53 +26,53 @@
   "Tests whether thing is a node of a lattice diagram or not."
   [thing]
   (and (instance? GObject thing)
-       (= (:type @(.getUserData #^GObject thing)) :node)))
+       (= (:type @(.getUserData ^GObject thing)) :node)))

 (defn connection?
   "Tests whether thing is a connection of a lattice diagram or not."
   [thing]
   (and (instance? GObject thing)
-       (= (:type @(.getUserData #^GObject thing)) :connection)))
+       (= (:type @(.getUserData ^GObject thing)) :connection)))

 (defn position
   "Returns the position of a node in a lattice diagram."
-  [#^GObject node]
+  [^GObject node]
   (:position @(.getUserData node)))

 (defn radius
   "Returns the radius of a node in a lattice diagram."
-  [#^GObject node]
+  [^GObject node]
   (:radius @(.getUserData node)))

 (defn set-node-radius!
   "Sets radius of node."
-  [#^GObject node, radius]
+  [^GObject node, radius]
   (dosync
    (alter (.getUserData node) assoc :radius radius)))

 (defn get-name
   "Returns name of thing."
-  [#^GObject thing]
+  [^GObject thing]
   (:name @(.getUserData thing)))

 (defn lower-node
   "Returns for a connection conn the lower node in a lattice diagram."
-  [#^GObject conn]
+  [^GObject conn]
   (:lower @(.getUserData conn)))

 (defn upper-node
   "Returns for a connection conn the upper node in a lattice diagram."
-  [#^GObject conn]
+  [^GObject conn]
   (:upper @(.getUserData conn)))

 (defn upper-connections
   "Returns all upper connections for node in a lattice diagram."
-  [#^GObject node]
+  [^GObject node]
   (:upper @(.getUserData node)))

 (defn lower-connections
   "Returns all lower connections of node in a lattice diagram."
-  [#^GObject node]
+  [^GObject node]
   (:lower @(.getUserData node)))

 (defn upper-neighbors
@@ -133,9 +133,9 @@

 (defn- add-node
   "Adds a node to scn at position [x y]."
-  [#^GScene scn, x, y, name, [upper-label lower-label]]
-  (let [#^GSegment upper-segment (GSegment.),
-	#^GSegment lower-segment (GSegment.),
+  [^GScene scn, x, y, name, [upper-label lower-label]]
+  (let [^GSegment upper-segment (GSegment.),
+	^GSegment lower-segment (GSegment.),
 	object (proxy [GObject] []
 		 (draw []
 		   (let [upper-style (if (= 1 (-?> this upper-neighbors count))
@@ -162,8 +162,8 @@
     (doto scn
       (.add object))

-    (let [#^GText upper-text (GText. (print-str upper-label) GPosition/NORTH),
-	  #^GText lower-text (GText. (print-str lower-label) GPosition/SOUTH)]
+    (let [^GText upper-text (GText. (print-str upper-label) GPosition/NORTH),
+	  ^GText lower-text (GText. (print-str lower-label) GPosition/SOUTH)]
 	(.setStyle upper-text *default-node-label-style*)
 	(.setStyle lower-text *default-node-label-style*)
 	(.addText upper-segment upper-text)
@@ -171,6 +171,23 @@

     object))

+;;
+
+(defvar- *default-highlighted-node-style* (doto (GStyle.)
+                                            (.setForegroundColor Color/RED)
+                                            (.setBackgroundColor Color/WHITE)
+                                            (.setLineWidth 3.0))
+  "Default node style for lattice diagrams for highlighted nodes.")
+
+(defn- toggle-highlight
+  "Toggles the highlight-state of the given node."
+  [node]
+  (if (= (.getStyle node) *default-node-style*)
+    (.setStyle node *default-highlighted-node-style*)
+    (.setStyle node *default-node-style*)))
+
+;;
+
 (defvar- *default-line-style* (doto (GStyle.)
 				(.setLineWidth 2.0)
 				(.setForegroundColor Color/BLACK))
@@ -178,9 +195,9 @@

 (defn- connect-nodes
   "Connects two nodes on scene."
-  ([#^GScene scn, #^GObject x, #^GObject y]
+  ([^GScene scn, ^GObject x, ^GObject y]
     (connect-nodes scn x y (str (get-name x) " -> " (get-name y))))
-  ([#^GScene scn, #^GObject x, #^GObject y, name]
+  ([^GScene scn, ^GObject x, ^GObject y, name]
      (let [line (GSegment.),
 	   c    (proxy [GObject] []
 		  (draw []
@@ -229,7 +246,7 @@

 (defn move-node-unchecked-to
   "Moves node to [new-x new-y]."
-  [#^GObject node, new-x, new-y]
+  [^GObject node, new-x, new-y]
   ;; update self position
   (dosync
    (alter (.getUserData node) assoc :position [new-x new-y]))
@@ -238,11 +255,11 @@
   (.redraw node)

   ;; update connections to upper neighbors
-  (doseq [#^GObject c (upper-connections node)]
+  (doseq [^GObject c (upper-connections node)]
     (.redraw c))

   ;; update connections to lower neighbors
-  (doseq [#^GObject c (lower-connections node)]
+  (doseq [^GObject c (lower-connections node)]
     (.redraw c))

   ;; done
@@ -251,8 +268,7 @@
 (defn move-node-by
   "Moves node by [dx dy] making sure it will not be over some of its
   upper neighbors or under some of its lower neighbors."
-  ;; race condition when moving nodes too fast?
-  [#^GObject node, dx, dy]
+  [^GObject node, dx, dy]
   (let [[x y] (position node),

 	;; make sure nodes don't go too far
@@ -348,7 +364,6 @@
   [node]
   (all-additively-influenced-nodes node lower-neighbors upper-neighbors))

-
 ;;;

 (defn move-interaction
@@ -363,7 +378,7 @@
   (add-hook scene :move-stop)
   (let [interaction-obj (atom nil)]
     (proxy [GInteraction] []
-      (event [#^GScene scn, evt, x, y]
+      (event [^GScene scn, evt, x, y]
 	(condp = evt
 	   GWindow/BUTTON1_DOWN  (let [thing (.find scn x y)]
 				   (when (node? thing)
@@ -377,7 +392,11 @@
 				     (.refresh scn))),
 	   GWindow/BUTTON1_UP    (do
 				   (call-hook-with scn :move-stop @interaction-obj)
-				   (reset! interaction-obj nil))
+				   (reset! interaction-obj nil)),
+           GWindow/BUTTON3_DOWN  (let [thing (.find scn x y)]
+                                   (when (node? thing)
+                                     (toggle-highlight thing)
+                                     (.refresh scn))),
 	   nil)))))

 (defn zoom-interaction
@@ -386,9 +405,9 @@
   take no arguments."
   [scene]
   (add-hook scene :zoom-event)
-  (let [#^ZoomInteraction zoom-obj (ZoomInteraction. scene)]
+  (let [^ZoomInteraction zoom-obj (ZoomInteraction. scene)]
     (proxy [GInteraction] []
-      (event [#^GScene scn, evt, x, y]
+      (event [^GScene scn, evt, x, y]
 	(.event zoom-obj scn evt x y)
 	(when scn
 	  (call-hook-with scn :zoom-event)


Added support for google closure compilation of foreign libraries

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -161,6 +161,8 @@
 (defmethod to-url String [s] (to-url (io/file s)))

 (defprotocol IJavaScript
+  (-foreign? [this] "Whether the Javascript represents a foreign
+  library (a js file that not have any goog.provide statement")
   (-url [this] "The URL where this JavaScript is located. Returns nil
   when JavaScript exists in memory only.")
   (-provides [this] "A list of namespaces that this JavaScript provides.")
@@ -170,12 +172,14 @@
 (extend-protocol IJavaScript

   String
+  (-foreign? [this] false)
   (-url [this] nil)
   (-provides [this] (:provides (parse-js-ns (string/split-lines this))))
   (-requires [this] (:requires (parse-js-ns (string/split-lines this))))
   (-source [this] this)

   clojure.lang.IPersistentMap
+  (-foreign? [this] (:foreign this))
   (-url [this] (or (:url this)
                    (to-url (:file this))))
   (-provides [this] (map name (:provides this)))
@@ -184,18 +188,20 @@
                     s
                     (slurp (io/reader (-url this))))))

-(defrecord JavaScriptFile [^URL url provides requires]
+(defrecord JavaScriptFile [foreign ^URL url provides requires]
   IJavaScript
+  (-foreign? [this] foreign)
   (-url [this] url)
   (-provides [this] provides)
   (-requires [this] requires)
   (-source [this] (slurp (io/reader url))))

-(defn javascript-file [^URL url provides requires]
-  (JavaScriptFile. url (map name provides) (map name requires)))
+(defn javascript-file [foreign ^URL url provides requires]
+  (JavaScriptFile. foreign url (map name provides) (map name requires)))

 (defn map->javascript-file [m]
-  (javascript-file (to-url (:file m))
+  (javascript-file (:foreign m)
+                   (to-url (:file m))
                    (:provides m)
                    (:requires m)))

@@ -371,6 +377,27 @@
 ;; need for closurebuilder. cljs dependencies will be compiled as
 ;; needed.

+(defn find-url
+  "Given a string, returns a URL. Attempts to resolve as a classpath-relative
+  path, then as a path relative to the working directory or a URL string"
+  [path-or-url]
+  (or (io/resource path-or-url)
+      (try (io/as-url path-or-url)
+           (catch java.net.MalformedURLException e
+             false))
+      (io/as-url (io/as-file path-or-url))))
+
+(defn load-foreign-library*
+  "Given a library spec (a map containing the keys :file
+  and :provides), returns a map containing :provides, :requires, :file
+  and :url"
+  [lib-spec]
+  (merge lib-spec {:foreign true
+                   :requires nil
+                   :url (find-url (:file lib-spec))}))
+
+(def load-foreign-library (memoize load-foreign-library*))
+
 (defn load-library*
   "Given a path to a JavaScript library, which is a directory
   containing Javascript files, return a list of maps
@@ -386,15 +413,22 @@

 (def load-library (memoize load-library*))

-(defn library-dependencies [{:keys [libs]}]
-  (mapcat load-library libs))
+(defn library-dependencies [{:keys [libs foreign-libs]}]
+  (concat
+   (mapcat load-library libs)
+   (map load-foreign-library foreign-libs)))

 (comment
   ;; load one library
   (load-library* "closure/library/third_party/closure")
   ;; load all library dependencies
   (library-dependencies {:libs ["closure/library/third_party/closure"]})
-  )
+  (library-dependencies {:foreign-libs [{:file "http://example.com/remote.js"
+                                          :provides ["my.example"]}]})
+  (library-dependencies {:foreign-libs [{:file "local/file.js"
+                                            :provides ["my.example"]}]})
+  (library-dependencies {:foreign-libs [{:file "cljs/nodejs_externs.js"
+                                          :provides ["my.example"]}]}))

 (defn goog-dependencies*
   "Create an index of Google dependencies by namespace and file name."
@@ -413,6 +447,7 @@
                          :group :goog)))))

 (def goog-dependencies (memoize goog-dependencies*))
+

 (defn js-dependency-index
   "Returns the index for all JavaScript dependencies. Lookup by
@@ -501,7 +536,8 @@
   (let [requires (mapcat -requires inputs)
         required-cljs (cljs-dependencies opts requires)
         required-js (js-dependencies opts (set (concat (mapcat -requires required-cljs) requires)))]
-    (concat (map #(-> (javascript-file (or (:url %) (io/resource (:file %)))
+    (concat (map #(-> (javascript-file (:foreign %)
+                                       (or (:url %) (io/resource (:file %)))
                                        (:provides %)
                                        (:requires %))
                       (assoc :group (:group %))) required-js)
@@ -520,10 +556,16 @@
                     (str "goog.provide('test.app');\n"
                          "goog.require('goog.array');\n"
                          "goog.require('goog.dom.query');"))
+  ;; add dependencies with foreign lib
+  (add-dependencies {:foreign-libs [{:file "samples/hello/src/hello/core.cljs"
+                                     :provides ["example.lib"]}]}
+                    (str "goog.provide('test.app');\n"
+                         "goog.require('example.lib');\n"))
   ;; add dependencies to a JavaScriptFile record
-  (add-dependencies {} (javascript-file (to-url "samples/hello/src/hello/core.cljs")
-                                     ["hello.core"]
-                                     ["goog.array"]))
+  (add-dependencies {} (javascript-file false
+                                        (to-url "samples/hello/src/hello/core.cljs")
+                                        ["hello.core"]
+                                        ["goog.array"]))
   )

 ;; Optimize
@@ -539,9 +581,18 @@

 (defmethod javascript-name JavaScriptFile [js] (javascript-name (-url js)))

+(defn build-provides
+  "Given a vector of provides, builds required goog.provide statements"
+  [provides]
+  (apply str (map #(str "goog.provide('" % "');\n") provides)))
+
+
 (defmethod js-source-file JavaScriptFile [_ js]
-  (when-let [url (-url js)]
-    (js-source-file (javascript-name url) (io/input-stream url))))
+           (when-let [url (-url js)]
+             (js-source-file (javascript-name url)
+                             (if (-foreign? js)
+                               (str (build-provides (-provides js)) (slurp url))
+                               (io/input-stream url)))))

 (defn optimize
   "Use the Closure Compiler to optimize one or more JavaScript files."


Adds remaining artist doc strings

Adds remaining artist doc strings

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -87,12 +87,12 @@
     Example: (get-tracks-of-album {:id \"3XCGFOBqESirxxICswSity\" :market \"SE\" :limit 50 :offset 50} \"BQBw-JtC..._7GvA\")")

 ;Artists
-(spotify-api-call get-artist client/get (str spotify-api-url "artists/id")
+(spotify-api-call get-an-artist client/get (str spotify-api-url "artists/id")
 " Takes two arguments, a map m with query parameters and an optional oauth-token t.
     Compulsory key in m is :id.
     :id has to have the value of an existing artist's id.

-    Example: (get-artist {:id \"5CE2IfdYZEQGIDsfiRm8SI\"} \"BQBw-JtC..._7GvA\")")
+    Example: (get-an-artist {:id \"5CE2IfdYZEQGIDsfiRm8SI\"} \"BQBw-JtC..._7GvA\")")

 (spotify-api-call get-several-artists client/get (str spotify-api-url "artists")
 " Takes two arguments, a map m with query parameters and an optional oauth-token t.
@@ -101,9 +101,32 @@

     Example: (get-several-artists {:ids \"1kK2LYgoP3raZNngbb1qMT,2RitCPbwEYyYNw5LkbXTGv\"} \"BQBw-JtC..._7GvA\")")

-(spotify-api-call get-artists-albums client/get (str spotify-api-url "artists/id/albums") "")
-(spotify-api-call get-artists-top-tracks client/get (str spotify-api-url "artists/id/top-tracks") "")
-(spotify-api-call get-artists-related-artists client/get (str spotify-api-url "artists/id/related-artists") "")
+(spotify-api-call get-an-artists-albums client/get (str spotify-api-url "artists/id/albums")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory key in m is :id, optional keys are :album_type, :market, :limit and :offset.
+    :id has to have the value of an existing artist's id.
+    :album_type a comma-separated list of one or several of the following:
+     album, single, appears_on and compilation. Default is to query for all types.
+    :market is an ISO 3166-1 alpha-2 country code.
+    :limit is the maxium number of tracks to return, default is 20.
+    :offset is the index of the first track to return, default is 0.
+
+    Example: (get-an-artists-albums {:id \"7lOJ7WXyopaxri0dbOiZkd\" :album_type \"album, single\" :market \"SE\" :limit 50 :offset 50}} \"BQBw-JtC..._7GvA\")")
+
+(spotify-api-call get-an-artists-top-tracks client/get (str spotify-api-url "artists/id/top-tracks")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory keys in m are :id and :country.
+    :id has to be a spotify artist id.
+    :country is an ISO 3166-1 alpha-2 country code.
+
+    Example: (get-an-artists-top-tracks {:id \"7hCsRnXtcbez8msLPfjbkz\" :country \"SE\"} \"BQBw-JtC..._7GvA\")")
+
+(spotify-api-call get-an-artists-related-artists client/get (str spotify-api-url "artists/id/related-artists")
+" Takes two arguments, a map m with query parameters and an optional oauth-token t.
+    Compulsory key in m is :id.
+    :id has to be a spotify artist id.
+
+    Example: (get-an-artists-related-artists {:id \"4EF5vIcCYKMM61oYOG2Tqa\"} \"BQBw-JtC..._7GvA\")")

 ;Browse
 (spotify-api-call get-a-list-of-featured-playlists client/get (str spotify-api-url "browse/featured-playlists") "")


Refactored player code to make button functions responsible for update the atom.

--- src/cljs/vdd/player.cljs
+++ src/cljs/vdd/player.cljs
@@ -21,59 +21,54 @@
        [:a.btn.last {:href "#"}[:i.icon-step-forward]]]]
      [:div.slider]]))

-(defn- ui-state-helper
-  "A helper function that will unwrap the state of the player state atom and invoke the
-  given ui function."
-  [player-state-atom ui-fn]
-  (let [player-state @player-state-atom
-        items (:items player-state)
-        data-handler (:data-handler player-state)
-        item-index (:index player-state)
-        new-state (ui-fn player-state items data-handler item-index)]
-    (when new-state (reset! player-state-atom new-state))))
-

 (defn- play
   "Handles the play button press."
-  [player-state items data-handler item-index]
+  [player-state-atom]
+
   )

 (defn- pause
   "Handles the pause button press."
-  [player-state items data-handler item-index]
+  [player-state-atom]
   )

 (defn- go-to-index
   "Helper function to go to a specific index"
-  [player-state items data-handler new-index]
-  (when (and (>= new-index 0)
-           (< new-index (count items))
-           (not= new-index (:index player-state)))
-    (let [item (nth items new-index)]
-      (data-handler item)
-      (ui.slider/set-value! (:slider player-state) new-index)
-
-      (assoc player-state :index new-index))))
+  [player-state-atom new-index-fn]
+  (let [player-state @player-state-atom
+        {items :items
+         data-handler :data-handler
+         item-index :index} player-state
+        new-index (new-index-fn item-index)]
+    (when (and (>= new-index 0)
+               (< new-index (count items))
+               (not= new-index item-index))
+      (let [item (nth items new-index)]
+        (data-handler item)
+        (ui.slider/set-value! (:slider player-state) new-index)
+        (swap! player-state-atom assoc :index new-index)))))

 (defn- back
   "Handles the back button press."
-  [player-state items data-handler item-index]
-  (go-to-index player-state items data-handler (dec item-index)))
+  [player-state-atom]
+  (go-to-index player-state-atom dec))

 (defn- forward
   "Handles the forward step button press."
-  [player-state items data-handler item-index]
-  (go-to-index player-state items data-handler (inc item-index)))
+  [player-state-atom]
+  (go-to-index player-state-atom inc))

 (defn- jump-to-first
   "Handles the jump to first button press"
-  [player-state items data-handler item-index]
-  (go-to-index player-state items data-handler 0))
+  [player-state-atom]
+  (go-to-index player-state-atom (constantly 0)))

 (defn- jump-to-last
   "Handles the jump to last button press"
-  [player-state items data-handler item-index]
-  (go-to-index player-state items data-handler (-> items count dec)))
+  [player-state-atom]
+  (go-to-index player-state-atom (constantly
+                                   (-> @player-state-atom :items count dec))))

 (defn- create-player-state
   "Creates the initial state of the player control"
@@ -92,10 +87,11 @@
   [player-state-atom items data-handler]
   (let [player-state @player-state-atom
         slider (:slider player-state)
-        player-state (create-player-state slider items data-handler)
-        player-state (go-to-index player-state items data-handler 0)]
+        player-state (create-player-state slider items data-handler)]
+    (reset! player-state-atom player-state)
+    (jump-to-first player-state-atom)
     ; Set the max state of the slider
-    (ui.slider/set-option! slider "max" (dec (count items)))
+    (ui.slider/set-option! slider "max" (-> player-state :items count dec))

     (reset! player-state-atom player-state)
     (log "Player data set!")))
@@ -108,19 +104,13 @@
     type - the button type. ie :pause
     handler-fn - the function that should be called when the button is clicked."
   [player state-atom type handler-fn]
-  (let [btn (.find player (str "a." (name type)))
-        btn-click-handler (partial ui-state-helper state-atom handler-fn)]
-    (.click btn btn-click-handler)))
+  (let [btn (.find player (str "a." (name type)))]
+    (.click btn (partial handler-fn state-atom))))

 (defn- slide
   "Handles the slider sliding to a new value."
   [state-atom new-index]
-  (let [player-state @state-atom
-        items (:items player-state)
-        data-handler (:data-handler player-state)
-        new-state (go-to-index player-state items data-handler new-index)]
-    (when new-state
-      (reset! state-atom new-state))))
+  (go-to-index state-atom (constantly new-index)))

 (defn- setup-slider
   [player state-atom]


AES not hardcoded

AES not hardcoded

--- src/compojure/crypto.clj
+++ src/compojure/crypto.clj
@@ -76,7 +76,7 @@
 (defn- make-algorithm
   "Return an algorithm string suitable for JCE from a map of options."
   [options]
-  (str "AES/" (options :mode) "/" (options :padding)))
+  (str (options :algorithm) "/" (options :mode) "/" (options :padding)))

 (defn- make-cipher
   "Create an AES Cipher instance."


PR comments

PR comments

--- search-app/src/cmr/search/validators/opendata.clj
+++ search-app/src/cmr/search/validators/opendata.clj
@@ -15,12 +15,10 @@

 (def opendata-schemas
   {:catalog (load-opendata-schema "catalog")
-   :dataset (load-opendata-schema "dataset")
-   :distribution (load-opendata-schema "distribution")
-   :organization (load-opendata-schema "organization")
-   :vcard (load-opendata-schema "vcard")})
+   :dataset (load-opendata-schema "dataset")})

 (defn validate-dataset
   "Validate a given opendata record"
   [dataset]
-  (json-schema/validate-json (load-opendata-schema "catalog") dataset))
+  ;; A catalog refers to a collection of datasets, which is what we're dealing with
+  (json-schema/validate-json (:catalog opendata-schemas) dataset))


Cmr 7977 (#1721)

Cmr 7977 (#1721)

* Moved in-memory cache to redis

* Changing cache setup to be in line with others

--- search-app/src/cmr/search/services/query_execution/has_granules_or_cwic_results_feature.clj
+++ search-app/src/cmr/search/services/query_execution/has_granules_or_cwic_results_feature.clj
@@ -13,6 +13,10 @@
    [cmr.common.cache :as cache]
    [cmr.common.cache.in-memory-cache :as mem-cache]
    [cmr.common.jobs :refer [defjob]]
+   [cmr.redis-utils.redis-cache :as redis-cache]
+   [cmr.transmit.cache.consistent-cache :as consistent-cache]
+   [cmr.common.cache.fallback-cache :as fallback-cache]
+   [cmr.common.cache.single-thread-lookup-cache :as stl-cache]
    [cmr.search.data.elastic-search-index :as idx]))

 (def REFRESH_HAS_GRANULES_OR_CWIC_MAP_JOB_INTERVAL
@@ -29,12 +33,34 @@
 (defn create-has-granules-or-cwic-map-cache
   "Returns a 'cache' which will contain the cached has granules map."
   []
-  (mem-cache/create-in-memory-cache))
+  ;; Single threaded lookup cache used to prevent indexing multiple items at the same time with
+  ;; empty cache cause lots of lookups in elasticsearch.
+  (stl-cache/create-single-thread-lookup-cache
+    ;; Use the fall back cache so that the data is fast and available in memory
+    ;; But if it's not available we'll fetch it from redis.
+    (fallback-cache/create-fallback-cache
+
+      ;; Consistent cache is required so that if we have multiple instances of the indexer we'll
+      ;; have only a single indexer refreshing its cache.
+      (consistent-cache/create-consistent-cache
+       {:hash-timeout-seconds (* 5 60)})
+      (redis-cache/create-redis-cache))))

 (defn create-has-granules-or-opensearch-map-cache
   "Returns a 'cache' which will contain the cached has granules map."
   []
-  (mem-cache/create-in-memory-cache))
+  ;; Single threaded lookup cache used to prevent indexing multiple items at the same time with
+  ;; empty cache cause lots of lookups in elasticsearch.
+  (stl-cache/create-single-thread-lookup-cache
+    ;; Use the fall back cache so that the data is fast and available in memory
+    ;; But if it's not available we'll fetch it from redis.
+    (fallback-cache/create-fallback-cache
+
+      ;; Consistent cache is required so that if we have multiple instances of the indexer we'll
+      ;; have only a single indexer refreshing its cache.
+      (consistent-cache/create-consistent-cache
+       {:hash-timeout-seconds (* 5 60)})
+      (redis-cache/create-redis-cache))))

 (defn get-cwic-collections
   "Returns the collection granule count by searching elasticsearch by aggregation"


CMR-3823 Fix test

CMR-3823 Fix test

--- system-int-test/test/cmr/system_int_test/search/collection_search_keyword_wildcard_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_keyword_wildcard_test.clj
@@ -28,33 +28,33 @@
        keyword-string (str/join " " keyword-strings)]
   (search/find-refs :collection {:keyword keyword-string})))

-#_(deftest search-keyword-wildcard-limits-test)
- ;; There is a total limit on max wildcards, but we want to test all the
- ;; combinations even if they go over that, so overwite that number to the
- ;; maximum + 1
- (let [orig-keyword-wildcard-max query-to-elastic/KEYWORD_WILDCARD_NUMBER_MAX]
-  (intern 'cmr.search.data.query-to-elastic 'KEYWORD_WILDCARD_NUMBER_MAX
-   (inc (#'query-to-elastic/get-max-kw-number-allowed 1)))
+#_(deftest search-keyword-wildcard-limits-test
+   ;; There is a total limit on max wildcards, but we want to test all the
+   ;; combinations even if they go over that, so overwite that number to the
+   ;; maximum + 1
+   (let [orig-keyword-wildcard-max query-to-elastic/KEYWORD_WILDCARD_NUMBER_MAX]
+    (intern 'cmr.search.data.query-to-elastic 'KEYWORD_WILDCARD_NUMBER_MAX
+     (inc (#'query-to-elastic/get-max-kw-number-allowed 1)))

-  ;; For each keyword length to 241, test that the maximum in the mapping is
-  ;; correct and does not result in a 500 error
-  (let [failed-atom (atom false)]
-   (doseq [x (range 3 241)
-           :when (not @failed-atom) ;; Stop test on failure
-           :let [max-num-keywords (#'query-to-elastic/get-max-kw-number-allowed x)
-                 result (test-limit max-num-keywords x)]]
-     (println "Testing keyword length " x)
-     (when-not
-      (is (or (= 200 (:status result)) (nil? (:status result)))
-          (format
-           (str "Keyword wildcard limit of %d is incorrect for max keyword string "
-                "length of %d")
-           max-num-keywords x))
-      (reset! failed-atom true))))
+    ;; For each keyword length to 241, test that the maximum in the mapping is
+    ;; correct and does not result in a 500 error
+    (let [failed-atom (atom false)]
+     (doseq [x (range 3 241)
+             :when (not @failed-atom) ;; Stop test on failure
+             :let [max-num-keywords (#'query-to-elastic/get-max-kw-number-allowed x)
+                   result (test-limit max-num-keywords x)]]
+       (println "Testing keyword length " x)
+       (when-not
+        (is (or (= 200 (:status result)) (nil? (:status result)))
+            (format
+             (str "Keyword wildcard limit of %d is incorrect for max keyword string "
+                  "length of %d")
+             max-num-keywords x))
+        (reset! failed-atom true))))

-  ;; Set KEYWORD_WILDCARD_NUMBER_MAX back to the original value
-  (intern 'cmr.search.data.query-to-elastic 'KEYWORD_WILDCARD_NUMBER_MAX
-   orig-keyword-wildcard-max))
+    ;; Set KEYWORD_WILDCARD_NUMBER_MAX back to the original value
+    (intern 'cmr.search.data.query-to-elastic 'KEYWORD_WILDCARD_NUMBER_MAX
+     orig-keyword-wildcard-max)))

 (comment


Adds Eastwood for Clojure linting.

Adds Eastwood for Clojure linting.

--- lein/lein.symlink/profiles.clj
+++ lein/lein.symlink/profiles.clj
@@ -1 +1,6 @@
-{:user {:plugins [[cider/cider-nrepl "0.8.2"]]}}
+{:user {
+        :plugins [[cider/cider-nrepl "0.8.2"] [jonase/eastwood "0.2.1"]]
+        ; Clojure linting with Eastwood
+        :dependencies [[jonase/eastwood "0.2.1" :exclusions [org.clojure/clojure]]]
+        }}
+


simplify util props->html

simplify util props->html

--- src/cljs/daveconservatoire/site/ui/util.cljs
+++ src/cljs/daveconservatoire/site/ui/util.cljs
@@ -26,8 +26,7 @@
 (defn props->html [attrs props]
   (->> (merge-with html-attr-merge attrs props)
        (parse-route)
-       (filter (fn [[k _]] (not (namespace k))))
-       (into {})
+       (into {} (filter (fn [[k _]] (not (namespace k)))))
        (clj->js)))

 (s/fdef props->html


Correct error in random timestamps

Correct error in random timestamps

Previous commits returned a date in the range [0, 31).

This commit changes that range to [1, 31].

--- src/test_utils/core.cljs
+++ src/test_utils/core.cljs
@@ -36,7 +36,7 @@
 (defn rand-timestamp [begin-year end-year]
   "Return a vector with random timestamp elements with years in the range
   [begin-year, end-year)."
-  [(rand-range begin-year end-year) (rand-range 1 13) (rand-int 31)
+  [(rand-range begin-year end-year) (rand-range 1 (inc 12)) (rand-range 1 (inc 31))
    (rand-int 24) (rand-int 60) (rand-int 60)])

 (defn draw-normal


Draw edges/vertices from spec vectors

Draw edges/vertices from spec vectors

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -36,7 +36,7 @@
     (string/join " " (map str ["M" "L" "L"] coords))))

-(defn line [from to color id]
+(defn svg-edge [[id [from to color]]]
   [:svg:path
    {:class "clickable"
     :id id
@@ -49,13 +49,6 @@
     :marker-end "url(#Vertex)"}])

-(.appendChild (dommy.core/sel1 :.forsvg)
-              (crate/html [:svg:svg {:width 1000 :height 1000}
-                           [:svg:defs
-                            triangle-marker
-                            circle-marker]
-                           (line [100, 20] [200, 40] "#6666ff" "one")
-                           (line [200, 40] [100, 80] "red" "two")]))

 (defn e->tid [e]
   (-> e
@@ -68,17 +61,43 @@
   (js/alert "123"))

 (def vertex-loc [[40 40]
-                 [100 40]
-                 [100 100]
-                 [40 100]])
+                 [300 40]
+                 [300 300]
+                 [40 300]])

 (def edges-vec [[0 1 "red"]
                 [1 2 "blue"]
                 [2 3 "red"]
                 [3 1 "red"]])

+
+(defn edge->endpoints [locations [start end color]]
+  [(locations start) (locations end) color])
+
+
+(defn make-edges [edges locations]
+  (let [edge-ids (map (partial str "edge") (range))
+        edges-with-endpoints (map (partial edge->endpoints locations) edges)]
+    (into {} (map vector edge-ids edges-with-endpoints))))
+
+
+
+(.log js/console (str (make-edges edges-vec vertex-loc)))
+
+(defn make-svg [[width height] edges]
+  [:svg:svg {:width width :height height}
+   [:svg:defs
+    triangle-marker
+    circle-marker]
+   (map svg-edge edges)]
+  )
+
+(.appendChild (dommy.core/sel1 :.forsvg)
+              (crate/html (make-svg [1000 1000]
+                                    (make-edges edges-vec vertex-loc)
+                                    )))
+
 (map #(dommy.core/listen! % :click click-handler) (dommy.core/sel :.clickable))
-
 ; (dommy.core/append (dommy.core/parent (dommy.core/sel1 :circle))
 ;                    (crate/html
 ;                      [:svg:line]))


Review feedback: Rename function

Review feedback: Rename function

--- scheduler/src/cook/rest/api.clj
+++ scheduler/src/cook/rest/api.clj
@@ -1489,7 +1489,7 @@
 (histograms/defhistogram [cook-mesos api list-request-param-limit])
 (histograms/defhistogram [cook-mesos api list-response-job-count])

-(defn list-jobents
+(defn list-job-ents
   "Queries using the params from ctx and returns the jobs that were found as datomic entities."
   [db include-custom-executor? ctx]
   (timers/time!
@@ -1522,7 +1522,7 @@
 (defn list-jobs
   "Queries using the params from ctx and returns the job uuids that were found"
   [db include-custom-executor? ctx]
-  (map :job/uuid (list-jobents db include-custom-executor? ctx)))
+  (map :job/uuid (list-job-ents db include-custom-executor? ctx)))

 (defn jobs-list-exist?
   [conn ctx]
@@ -2587,7 +2587,7 @@
     :handle-ok (fn [ctx]
                  (timers/time!
                    (timers/timer ["cook-scheduler" "handler" "list-endpoint-duration"])
-                   (let [job-ents (list-jobents db false ctx)]
+                   (let [job-ents (list-job-ents db false ctx)]
                      (mapv (partial fetch-job-map-from-entity db) job-ents))))))

 ;;


Add text to help debug animation. Also more named knobs. #48

--- samples/twitterbuzz/src/twitterbuzz/showgraph.cljs
+++ samples/twitterbuzz/src/twitterbuzz/showgraph.cljs
@@ -5,14 +5,21 @@
             [goog.dom :as dom]
             [goog.events :as events]
             [goog.fx.Animation :as anim]
+            [goog.graphics.Font :as Font]
+            [goog.graphics.Stroke :as Stroke]
+            [goog.graphics.SolidFill :as SolidFill]
             [goog.graphics :as graphics]))

 ; Drawing configuration
 (def avatar-size 0.07) ; used for both x and y dimensions of avatars
 (def edge-widths [0 0.001 0.005 0.010 0.020]) ; More mentions == thicker edges
+(def anneal-skipping 100)
+(def cooling 1000)
+(defn debug [_])
+;(defn debug [a] (str "t: " (:t a) " score: " (:best-score a)))

 ; BAD HACK: don't change globals like this -- find a better way:
-(set! anim/TIMEOUT 500)
+;(set! anim/TIMEOUT 500)

 (def edge-strokes
   (vec (map #(graphics/Stroke. % "#009") edge-widths)))
@@ -23,7 +30,11 @@
   (doto (graphics/createGraphics "100%" "100%" 1.0 1.0)
     (.render (dom/getElement "network"))))

-(defn draw-graph [{:keys [locs mentions]}]
+(def font (graphics/Font. 0.03 "Arial"))
+(def stroke (graphics/Stroke. 0.001 "#f00"))
+(def fill (graphics/SolidFill. "#f00"))
+
+(defn draw-graph [{:keys [locs mentions]} text]
   (. g (clear))

   ; Draw mention edges
@@ -38,26 +49,21 @@
   (let [offset (/ avatar-size 2)]
     (doseq [[username {:keys [x y]}] locs]
       (.drawImage g (- x offset) (- y offset) avatar-size avatar-size
-                  (:image-url (get mentions username))))))
+                  (:image-url (get mentions username)))))
+
+  (when text (.drawTextOnLine g text 0 0.02 0 1 "left" font stroke fill)))

 ; This is temporary.  The graph data should flow somehow from the
 ; tweets.  For now, just hardcode some:
 (def test-users {"djspiewak" {:image-url "http://a0.twimg.com/profile_images/746976711/angular-final_normal.jpg", :last-tweet "Does Clojure have a Sinatra clone?", :mentions {}}, "tobsn" {:image-url "http://a2.twimg.com/profile_images/1364411587/yr40_normal.png", :last-tweet "Creating a Query DSL using Clojure and MongoDB http://tob.sn/qgCxkm #mongodb", :mentions {}}, "CzarneckiD" {:image-url "http://a3.twimg.com/profile_images/1156755747/head_trees_normal.jpg", :last-tweet "@greymouser I need to start writing some Clojure I guess :)", :mentions {"greymouser" 2}}, "sbtourist" {:image-url "http://a0.twimg.com/profile_images/72494229/Cryer_Black_normal.jpg", :last-tweet "Clooj, a lightweight Clojure IDE: http://t.co/OSCjr9X", :mentions {"djspiewak" 2}}, "jboner" {:image-url "http://a2.twimg.com/profile_images/1395654712/jonas_bw_small_normal.JPG", :last-tweet "RT @sbtourist: Clooj, a lightweight Clojure IDE: http://t.co/OSCjr9X", :mentions {"sbtourist" 2, "djspiewak" 2, "romanroe" 2}}})

-(def test-graph (atom (list
-  {"jboner" {:x 0.2 :y 0.8} "djspiewak" {:x 0.3 :y 0.2}}
-  {"jboner" {:x 0.4 :y 0.7} "djspiewak" {:x 0.4 :y 0.3}}
-  {"jboner" {:x 0.3 :y 0.8} "sbtourist" {:x 0.3 :y 0.2} "djspiewak" {:x 0.5 :y 0.5}}
-  {"jboner" {:x 0.2 :y 0.7} "sbtourist" {:x 0.4 :y 0.1} "djspiewak" {:x 0.7 :y 0.4}})))
-
 (def animation (atom nil))
-
-;(set! cljs.core/string-print (fn [x] (js* "console.log(~{x})")))

 (set! (.cycle animation)
   (fn [t]
-    (draw-graph (:best (first @animation)))
-    (swap! animation rest)))
+    (let [a (first @animation)]
+      (draw-graph (:best a) (debug a)))
+    (swap! animation #(drop anneal-skipping %))))

 (events/listen
   (dom/getElement "network")
@@ -66,7 +72,7 @@
     (reset! animation
       (ann/anneal
         layout/score
-        (ann/linear-cooling 1000)
+        (ann/linear-cooling cooling)
         layout/permute-move
         ann/standard-prob
         (layout/init-state test-users)))


Added *set-print* to test-runner

Added *set-print* to test-runner

--- src/leiningen/new/cljs_test/test_runner.cljs
+++ src/leiningen/new/cljs_test/test_runner.cljs
@@ -4,7 +4,11 @@

 (enable-console-print!)

-(defn runner []
-  (if (successful? (run-tests '{{name}}.core-test))
-    0
-    1))
+(defn runner []
+  (tt/run-tests
+    (tt/empty-env ::tt/default)
+    '{{name}}.core-test))
+
+(defn ^:export set-print-fn! [f]
+  (set! cljs.core.*print-fn* f))
+


Update web template

Update web template

--- src/clojure/leiningen/new/web_clojure/project.clj
+++ src/clojure/leiningen/new/web_clojure/project.clj
@@ -1,8 +1,8 @@
 (defproject {{name}} "0.0.1-SNAPSHOT"
   :description "FIXME: write this!"
   :dependencies [[org.clojure/clojure "1.5.1"]
-                 [org.clojure/clojurescript "0.0-2156"]
-                 [ring "1.2.1"]]
+                 [org.clojure/clojurescript "0.0-2173"]
+                 [ring "1.2.2"]]
   :plugins [[lein-cljsbuild "1.0.2"]
             [lein-ring "0.8.10"]]
   :hooks [leiningen.cljsbuild]


(PDB-1515) Use honeysql for population queries

--- src/puppetlabs/puppetdb/query/population.clj
+++ src/puppetlabs/puppetdb/query/population.clj
@@ -2,29 +2,52 @@
   "Population-wide queries

    Contains queries and metrics that apply across an entire population."
-  (:require [puppetlabs.puppetdb.jdbc :refer [query-to-vec table-count with-transacted-connection]]
+  (:require [puppetlabs.puppetdb.jdbc :refer [query-to-vec
+                                              table-count
+                                              with-transacted-connection]]
             [puppetlabs.kitchensink.core :refer [quotient]]
-            [metrics.gauges :refer [gauge]]))
+            [metrics.gauges :refer [gauge]]
+            [honeysql.core :as hcore]
+            [honeysql.helpers :as hh]))
+
+;;; Query library
+
+(def ^:private from-all-resources-and-their-nodes
+  (hcore/build :from [:catalogs :catalog_resources :certnames]
+               :merge-where [:and
+                             [:= :catalogs.id :catalog_resources.catalog_id]
+                             [:= :certnames.certname :catalogs.certname]]))
+
+(defn- where-nodes-are-active [q]
+  (hh/merge-where q [:and
+                     [:= :certnames.deactivated nil]
+                     [:= :certnames.expired nil]]))
+
+(defn- select-count [q]
+  (-> q
+      (hh/select [:%count.* :c])
+      hcore/format
+      query-to-vec
+      first
+      :c))
+
+;;; Public

 (defn num-resources
   "The number of resources in the population"
   []
   {:post [(number? %)]}
-  (-> (str "SELECT COUNT(*) AS c "
-           "FROM catalogs clogs, catalog_resources cr, certnames c "
-           "WHERE clogs.id=cr.catalog_id AND c.certname=clogs.certname AND c.deactivated IS NULL AND c.expired IS NULL")
-      (query-to-vec)
-      (first)
-      :c))
+  (-> from-all-resources-and-their-nodes
+      where-nodes-are-active
+      select-count))

 (defn num-nodes
   "The number of unique certnames in the population"
   []
   {:post [(number? %)]}
-  (-> "SELECT COUNT(*) AS c FROM certnames WHERE deactivated IS NULL AND expired IS NULL"
-      (query-to-vec)
-      (first)
-      :c))
+  (-> (hh/from :certnames)
+      where-nodes-are-active
+      select-count))

 (defn avg-resource-per-node
   "The average number of resources per node"
@@ -36,12 +59,13 @@
   "What percentage of resources in the population are duplicates"
   []
   {:post [(number? %)]}
-  (let [num-unique (-> (query-to-vec (str "SELECT COUNT(*) AS c FROM "
-                                          "(SELECT DISTINCT resource FROM catalog_resources cr, catalogs clogs, certnames c "
-                                          " WHERE cr.catalog_id=clogs.id AND clogs.certname=c.certname AND c.deactivated IS NULL AND c.expired IS NULL) r"))
-                       (first)
-                       (:c))
-        num-total  (num-resources)]
+  (let [distinct-resources-q (-> from-all-resources-and-their-nodes
+                                 where-nodes-are-active
+                                 (hh/select :catalog_resources.resource)
+                                 (hh/modifiers :distinct))
+        num-unique (-> (hh/from [distinct-resources-q :r])
+                       select-count)
+        num-total (num-resources)]
     (quotient (- num-total num-unique) num-total)))

 ;; ## Population-wide metrics


Prevent recursion into complex objects when doing js->clj

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -22,13 +22,19 @@
   (or (exists? (aget value "meta"))
       (exists? (aget value "_meta"))
       (exists? (aget value "__meta"))
-      (exists? (aget value "_hash"))))
+      (exists? (aget value "_hash"))
+      (exists? (aget value "devtools$format$IDevtoolsFormat$")))) ; we cannot detect deftypes in general, at least support those with IDevtoolsFormat

 (defn js-value? [value]
   (not (cljs-value? value)))

 (defn surrogate? [value]
   (exists? (aget value surrogate-key)))
+
+(defn stop-further-js->cls-recursion! [o]
+  (specify! o
+            IEncodeClojure
+            (-js->clj [x options] nil)))

 (defn template [tag style & children]
   (let [js-array #js [tag (if (empty? style) #js {} #js {"style" style})]]
@@ -39,18 +45,18 @@
     js-array))

 (defn reference [object & children]
-  (let [js-array #js ["object" #js {"object" object}]]
+  (let [js-array #js ["object" (stop-further-js->cls-recursion! #js {"object" object})]]
     (doseq [child children]
       (.push js-array child))
     js-array))

 (defn surrogate
   ([object header] (surrogate object header true))
-  ([object header has-body] (js-obj
-                              surrogate-key true
-                              "target" object
-                              "header" header
-                              "hasBody" has-body)))
+  ([object header has-body] (stop-further-js->cls-recursion! (js-obj
+                                                               surrogate-key true
+                                                               "target" object
+                                                               "header" header
+                                                               "hasBody" has-body))))

 (defn nil-template [_]
   (template span "color:#808080" "nil"))


Add some RethinkDB usage notes to REPL notes.

--- REPL_notes.clj
+++ REPL_notes.clj
@@ -26,4 +26,55 @@
 ;; Validate sections in sections.json against schema (should be all nils)
 (def sections*
   (->> common/sections (map #(assoc % :company-slug "x"))))
-(map #(schema/check common/Section %) sections*)+(map #(schema/check common/Section %) sections*)
+
+;; RethinkDB usage
+(def conn [:host "127.0.0.1" :port 28015 :db "open_company"])
+
+(aprint (with-open [c (apply r/connect conn)]
+  (-> (r/table "companies")
+      (r/get "buffer")
+      (r/run c))))
+
+(aprint (with-open [c (apply r/connect conn)]
+  (-> (r/table "companies")
+      (r/get "open-company")
+      (r/run c))))
+
+(with-open [c (apply r/connect conn)]
+  (-> (r/table "companies")
+      (r/get "prompt")
+      (r/update {:mission {:image "https://open-company.s3.amazonaws.com/mission.svg"}})
+      (r/run c)))
+
+(with-open [c (apply r/connect conn)]
+  (-> (r/table "companies")
+      (r/get "open-company")
+      (r/update {:finances {:image "https://open-company.s3.amazonaws.com/finances.svg"}})
+      (r/run c)))
+
+(aprint (with-open [c (apply r/connect conn)]
+  (-> (r/table "sections")
+  (r/get-all ["buffer"] {:index "company-slug"})
+  (r/run c))))
+
+(aprint (with-open [c (apply r/connect conn)]
+  (-> (r/table "sections")
+  (r/get-all [["buffer" "update"]] {:index "company-slug-section-name"})
+  (r/run c))))
+
+(aprint (with-open [c (apply r/connect conn)]
+  (-> (r/table "sections")
+  (r/get-all ["21c9ddd4-6d1c-47a5-b6c1-1308fed08523"] {:index "id"})
+  (r/run c))))
+
+(with-open [c (apply r/connect conn)]
+  (-> (r/table "sections")
+  (r/get-all ["70733852-21f7-4aba-bff6-de93ce699be2"] {:index "id"})
+  (r/update {:image "https://open-company.s3.amazonaws.com/diversity.svg"})
+  (r/run c)))
+
+;; for more RethinkDB help, see:
+;; https://github.com/apa512/clj-rethinkdb
+;; http://apa512.github.io/clj-rethinkdb/
+;; https://rethinkdb.com/api/python/


this will make a more regular grid

this will make a more regular grid

--- src/dwc_analysis/aoo.clj
+++ src/dwc_analysis/aoo.clj
@@ -96,7 +96,7 @@
         (map
           (fn [cluster]
             (cluster-points
-              (make-grid step (val cluster))
+              (make-grid step (key cluster))
               (val cluster)))
           (reduce merge
             (pmap


Add separate support for other comparisons

--- src/aerobio/htseq/wgseq.clj
+++ src/aerobio/htseq/wgseq.clj
@@ -150,6 +150,11 @@
         cfgjob (future (cmn/flow-program cfg get-toolinfo :run true))]
     cfgjob))

+(defmethod cmn/run-comparison :wgseq
+  [_ eid recipient compfile get-toolinfo template]
+  (run-wgseq-comparison
+   eid recipient compfile get-toolinfo template))
+
 (defmethod cmn/run-phase-2 :wgseq
   [_ eid recipient get-toolinfo template]
   (run-wgseq-comparison


Nilpoga

Nilpoga

--- src/antlion_clojure/bot.clj
+++ src/antlion_clojure/bot.clj
@@ -478,8 +478,9 @@

 (defn- matched-response?
   [txt response]
-  (some->> (:keywords response)
-           (some #(clojure.string/includes? txt %))))
+  (when txt
+    (some->> (:keywords response)
+             (some #(clojure.string/includes? txt %)))))

 (defn- registered-response-handler
   [{:keys [slack dynamodb res] :as opt} responses]


Refactor

Refactor

--- src/expound/printer.cljc
+++ src/expound/printer.cljc
@@ -73,27 +73,21 @@

 ;; TODO - bad name?

-(defn bracket [xs]
-  (str "| "
-       (string/join " | " xs)
-       " |"))
+(defn bracket [xs edge spacer middle]
+  (str edge spacer
+       (string/join (str spacer middle spacer) xs)
+       spacer edge))

 (defn table* [multirows]
   (let [row (first (first multirows))
-        ;; TODO - use bracket fn
-        divider (str  "|-" (string/join "-+-" (map
-                                               #(apply str (repeat (count (str %)) "-"))
-                                               row)) "-|")]
-    (flatten (interpose
-              divider
-              (map
-               (fn [multirow]
-                 (map
-                  (fn [row]
-                    (bracket row))
-                  multirow))
-
-               multirows)))))
+        columns-dividers (map #(apply str (repeat (count (str %)) "-")) row)
+        row-divider (bracket columns-dividers "|" "-" "+")]
+    (->> multirows
+         (map
+          (fn [multirow]
+            (map (fn [row] (bracket row "|" " " "|")) multirow)))
+         (interpose [row-divider])
+         (mapcat seq))))

 (defn table [multirows]
   (println)


update demo.cljc for newer grammar and naming conventions

--- src/babel/english/demo.cljc
+++ src/babel/english/demo.cljc
@@ -1,7 +1,6 @@
 (ns babel.english.demo
   (:require
-   [babel.english :refer [generate]]
-   [babel.english.grammar :refer [medium]]
+   [babel.english :refer [generate model]]
    [babel.english.morphology :refer [fo]]
    #?(:cljs [babel.logjs :as log])
    [clojure.string :as string]
@@ -17,8 +16,6 @@
 ;; run each (generate) as (time (generate)):
 (def ^:const timings? false)

-(def default-language-model (medium))
-
 (defn demo [ & [n spec]]
   (let [demo-specs
         [{:demo "Dog noun phrases"
@@ -33,7 +30,7 @@
          {:demo "The adventures of Luisa's yellow cat"
           :synsem {:cat :verb
                    :sem {:subj {:pred :cat
-                                :mod {:pred :yellow}
+                                :mod {:first {:pred :yellow}}
                                 :spec {:def :possessive
                                        :of {:pred :luisa}}}
                          :obj {:pred :top}}}}
@@ -58,7 +55,7 @@
                         (println)
                         (println log-message)
                         (println)
-                        (let [language-model (or (:lm spec) default-language-model)
+                        (let [language-model model
                               expressions (run-demo-with n (dissoc spec :lm) language-model)]
                           (count (pmap (fn [expression]
                                          (let [formatted (fo expression :show-notes false)]
@@ -72,7 +69,7 @@
                               spec)
                           demo-specs)
                   demo-specs)))
-    (println (str "babel demo is finished. JVM shutting down."))))
+    (println (str "babel demo is finished."))))

 (defn run-demo-with [n spec model]
   "print out _n_ generated sentences to stdout."
@@ -86,12 +83,9 @@
             (if timings?
               (take n (repeatedly
                        #(time
-                         (generate spec
-                                   :model model
-                                   :max-total-depth max-total-depth))))
+                         (generate spec model))))
               (take n (repeatedly
-                       #(generate spec
-                                  :model model
-                                  :max-total-depth max-total-depth)))))))
+                       #(generate spec model)))))))

+


Players that have 0 matches aren't shown in the ranking.

--- src/fist/routes/home.clj
+++ src/fist/routes/home.clj
@@ -54,7 +54,9 @@

 (defn stats-page []
   (layout/render
-    "stats.html" {:stats (sort #(compare (:s %2) (:s %1)) (map #(assoc (db/get-stats (:id %)) :name (:name %)) (db/get-players)))}))
+    "stats.html" {:stats (sort #(compare (:s %2) (:s %1))
+                           (filter #(> (:m %) 0)
+                             (map #(assoc (db/get-stats (:id %)) :name (:name %)) (db/get-players))))}))

 (defroutes home-routes
   (GET "/" [] (home-page))


Handle the default :pre/:post map if it happens to be used in the defconstrained macro body

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -227,9 +227,9 @@
                 body)
         body  (for [[args cnstr & bd] body]
                 (list* args
-                       (if (map? cnstr)
-                         cnstr
-                         (second (build-constraints-map args cnstr)))
+                       (if (vector? cnstr)
+                         (second (build-constraints-map args cnstr))
+                         cnstr)
                        bd))]
     `(defn ~name
        ~(if (:doc mdata) (:doc mdata) "")