Deleted api.cljs

Deleted api.cljs

--- src-cljs/photon/ui/api.cljs
+++ src-cljs/photon/ui/api.cljs
@@ -1,134 +0,0 @@
-(ns photon.ui.api
-  (:require-macros [cljs.core.async.macros :refer [go]])
-  (:require [om.next :as om :refer-macros [defui]]
-            [om.dom :as dom]
-            [goog.net.cookies :as ck]
-            [photon.ui.ws :as ws]
-            [photon.ui.components :as comp]))
-
-(defui PhotonApps
-  static om/IQuery
-  (query [this] `[:security-info])
-  Object
-  (render
-   [this]
-   (let [{:keys [security-info]} (om/props this)
-         apps (vals (get (:security security-info) "admin"))
-         apps-table (map
-                     #(-> %
-                          (select-keys [:app-name :description :website])
-                          (assoc :meta/original %)
-                          (assoc :action/show-keys :action/show-keys))
-                     apps)]
-     (dom/div
-      nil
-      (dom/div
-       #js {:className "row"}
-       ((om/factory comp/FormButton)
-        {:text "Create new app"
-         :onClick
-         (fn [_]
-           (om/transact! this `[(ui/update {:k :selected-app :v nil})
-                                (ui/update {:k :new-app :v true})
-                                :ui-state]))}))
-      (dom/div
-       #js {:className "row"}
-       ((om/factory comp/Table)
-        {:data apps-table :owner this
-         :rows [:app-name :description :website :action/show-keys]}))))))
-
-(defui AppInfo
-  static om/IQuery
-  (query [this] `[:security-info])
-  Object
-  (render
-   [this]
-   (let [{:keys [ui-state security]} (:security-info (om/props this))]
-     (dom/div
-      nil
-      (dom/div
-       #js {:className "row"}
-       (if (:new-app ui-state)
-         (dom/form
-          #js {:className "form-horizontal form-label-left"
-               :onSubmit (fn [e] (.preventDefault e) false)}
-          (comp/label-input
-           {:owner this :key :aform/name
-            :val (:aform/name ui-state) :label "Name"})
-          (comp/label-input
-           {:owner this :key :aform/description
-            :val (:aform/description ui-state) :label "Description"})
-          (comp/label-input
-           {:owner this :key :aform/website
-            :val (:aform/website ui-state) :label "App website"})
-          (comp/form-button
-           {:text "Create application"
-            :onClick
-            (fn [_]
-              (go
-                (<!
-                 (ws/post-api "/auth/app"
-                              {:query-params
-                               {:name (:aform/name ui-state)
-                                :description (:aform/description ui-state)
-                                :website (:aform/website ui-state)}}))
-                (om/transact! this `[(ui/update {:k :new-app :v false})
-                                     :ui-state])))}))
-         (if-let [app (:selected-app ui-state)]
-           (dom/form
-            #js {:className "form-horizontal form-label-left"
-                 :onSubmit (fn [e] (.preventDefault e) false)}
-            (comp/label-label
-             {:label "Name" :second-label (:app-name app)})
-            (comp/label-label
-             {:label "Description" :second-label (:description app)})
-            (comp/label-label
-             {:label "Website" :second-label (:website app)})
-            (comp/label-label
-             {:label "Client ID" :second-label (str (:client-id app))})
-            (comp/label-label
-             {:label "Client secret" :second-label (str (:client-secret app))})
-            (comp/label-label
-             {:label "Test URL"
-              :second-label
-              (str "curl \"" (ck/get "server") "/api/ping?client_id="
-                   (:client-id app) "&client_secret="
-                   (:client-secret app) "\"")})
-            #_(comp/label-input
-             {:owner this :key :aform/description
-              :val (:aform/description ui-state) :label "Description"})
-            #_(comp/label-input
-             {:owner this :key :aform/website
-              :val (:aform/website ui-state) :label "App website"})
-            #_(comp/form-button
-             {:text "Create application"
-              :onClick
-              (fn [_]
-                (go
-                  (<!
-                   (ws/post-api "/auth/app"
-                                {:query-params
-                                 {:name (:aform/name ui-state)
-                                  :description (:aform/description ui-state)
-                                  :website (:aform/website ui-state)}}))
-                  (om/transact! this `[(ui/update {:k :new-app :v false})
-                                       :ui-state])))}))
-           (dom/p nil "Select and existing app or create a new one"))))))))
-
-(defui ManageKeys
-  static om/IQuery
-  (query [this] `[{:security-info ~(om/get-query AppInfo)}
-                  {:security-info ~(om/get-query PhotonApps)}])
-  Object
-  (render
-   [this]
-   (dom/div
-    #js {:className "row"}
-    ((om/factory comp/HalfPanel)
-     {:title "Photon Apps"
-      :component PhotonApps
-      :data (om/props this)})
-    ((om/factory comp/HalfPanel)
-     {:title "App Info"
-      :component AppInfo
-      :data {}}))))


No need for threading macro in usage joining

--- src/hu/ssh/github_changelog/cli.clj
+++ src/hu/ssh/github_changelog/cli.clj
@@ -25,11 +25,12 @@
    ["-h" "--help"]])

 (defn- usage [summary]
-  (->> ["Usage: program-name [options...] <user/repo>"
-        ""
-        "Options:"
-        summary]
-       (join \newline)))
+  (join
+    \newline
+    ["Usage: program-name [options...] <user/repo>"
+     ""
+     "Options:"
+     summary]))

 (defn -main [& args]
   (let [{:keys [options arguments errors summary]} (cli/parse-opts args cli-options)


Add special routes for single-query test with response not in a vector

--- luminus/hello/src/hello/routes/home.clj
+++ luminus/hello/src/hello/routes/home.clj
@@ -7,7 +7,9 @@
 (defroutes home-routes
   (GET "/" [] "Hello, World!")
   (GET "/json" [] (response/json {:message "Hello, World!"}))
+  (GET "/db" [] (response/json (first (run-queries 1))))
   (GET "/db/:queries" [queries] (response/json (run-queries (get-query-count queries))))
+  (GET "/dbraw" [] (response/json (first (run-queries-raw 1))))
   (GET "/dbraw/:queries" [queries] (response/json (run-queries-raw (get-query-count queries))))
   (GET "/fortune" [] (layout/render "home.html" {:messages (get-fortunes)})))


Fix java.lang.IllegalArgumentException: Body may not be null

--- src/antlion_clojure/bot.clj
+++ src/antlion_clojure/bot.clj
@@ -464,6 +464,7 @@
         (map->Payload
           {:type :message
            :channel channel-id
+           :text ""
            :optionals {:attachments [{:text (str
                                              "<!here> " (:value co2) "ppmﾀﾞﾖ-\n"
                                              "*空気中のCo2濃度が" danger-ppm "ppmを超えました*")


more about {:pred :bag}

more about {:pred :bag}

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -112,7 +112,9 @@

    ;; <preds>
    {:pred :bag} {:artifact true
-                 :consuable false}
+                 :consumable false
+                 :event false
+                 :place false}

    {:pred :bicycle} {:artifact true
                      :consumable false}


reduce it

reduce it

--- src/bluebell/utils/core.clj
+++ src/bluebell/utils/core.clj
@@ -1,5 +1,7 @@
 (ns bluebell.utils.core
-  (:require [clojure.set]))
+  (:require [clojure.set]
+            [clojure.spec.alpha :as spec]
+            [clojure.spec.test.alpha :as stest]))

 (defn flatten-map-hierarchy [mh]


Added storage-changes.

Added storage-changes.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -62,11 +62,23 @@
              (when-let [change (get changes sq)]
                (when (not (:deleted change))
                  (aput storage-scan out
-                       {:opaque opaque :status :ok
+                       {:opaque opaque :status :part
                         :key key :sq sq :cas (:cas change)
-                        :val (:val change)}))))
-           (aput storage-scan out {:opaque opaque :status :ok})
-           (aclose storage-scan out)))
+                        :val (:val change)})))))
+         (aput storage-scan out {:opaque opaque :status :ok})
+         (aclose storage-scan out))
+    out))
+
+(defn storage-changes [actx storage opaque from to]
+  (let [out (achan actx)]
+    (ago storage-changes actx
+         (let [s @storage]
+             (doseq [[sq change] (subseq (into (sorted-map) (:changes s)) >= from < to)]
+               (aput storage-changes out (-> change
+                                             (assoc :opaque opaque)
+                                             (assoc :status :part)))))
+         (aput storage-changes out {:opaque opaque :status :ok})
+         (aclose storage-changes out))
     out))

 (defn make-storage-cmd-handlers [storage]
@@ -79,11 +91,9 @@
    "scan" [["from" "to"]
            (fn [c] {:rq #(storage-scan % storage (:opaque c) (:from c) (:to c))})]
    "changes" [["from" "to"]
-              (fn [c] {:rq
-                       (fn [actx]
-                         (ago storage-cmd-changes actx
-                              {:opaque (:opaque c) :status :ok
-                                :from (:from c) :to (:to c)}))})]
+              (fn [c] {:rq #(storage-changes % storage (:opaque c)
+                                             (js/parseInt (:from c))
+                                             (js/parseInt (:to c)))})]
    "noop" [[] (fn [c] {:rq
                        (fn [actx]
                          (ago storage-cmd-noop actx


fixing missing system-id in stage

fixing missing system-id in stage

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -96,7 +96,7 @@
   [type {:keys [system-id] :as spec}]
   (reload spec)
   ; reload may change system properties like ip etc..
-  (puppetize type (p/get-system system-id)))
+  (puppetize type (assoc (p/get-system system-id) :system-id system-id)))

 (deflow ^{:hook-args :run-info} run-action
   "Runs an action"


adding cloning workflow

adding cloning workflow

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -136,6 +136,15 @@
     (s/delete-system system-id)
     (info "system destruction done")))

+(deflow ^{:hook-args :clone-spec} clone
+  "Clones a system model and creates it"
+  [system-id clone-spec]
+   (when-not (s/system-exists? system-id)
+      (throw+ {:type ::system-missing} (<< "Could not clone missing system ~{system-id}")))
+    (let [id (s/clone-system system-id clone-spec)]
+      (create (s/get-system id) (s/get-system id))
+      (info "system cloned into" id)))
+
 (deflow clear
   "Clear system model (no machine destruction)"
   [{:keys [system-id] :as spec}]


Got all bookmark browsing working

Got all bookmark browsing working

--- src/cljs/bookmarx/core.cljs
+++ src/cljs/bookmarx/core.cljs
@@ -12,7 +12,7 @@
 (enable-console-print!)

 ;; -------------------------
-;; Views
+;; Components

 (defn header []
   [:span
@@ -47,35 +47,62 @@
            [:li [:a {:href "#"} "Bookmark Add"]]]]
          [:button {:class "dropdown-item" :type "button"} "Something else"]]]]]]])

-(defn bookmark [id]
-  (let [{:keys [db/id bookmark/name bookmark/url bookmark/rating bookmark/_parent open?]}
-        (session/get id)]
-    ;(println "Bookmark" id)
+(defn -get-route
+  "Gets the route to a menu in a tree by id."
+  ([id] (-get-route id [id]))
+  ([id route]
+   (if-let [parent (:bookmark/parent (session/get id))]
+     (recur (:db/id parent) (cons (:db/id parent) route))
+     route)))
+
+(defn breadcrumb
+  "Renders a breadcrumb."
+  [id name active?]
+  (if active?
+    [:li {:class "active" :key (str id "-bc-key")} name]
+    [:li {:key (str id "-bc-key")}
+     [:a {:on-click #(session/put! :active id) :key (str id "-a-key")} name]]))
+
+(defn breadcrumbs
+  []
+  (let [route (-get-route (session/get :active))]
+    [:ol {:class "breadcrumbs"}
+     (doall (map #(let [{:keys [db/id bookmark/name]} (session/get %)]
+                   (breadcrumb id name (= % (last route)))) route))]))
+
+(defn bookmark [mark]
+  (let [{:keys [db/id bookmark/name bookmark/url bookmark/rating bookmark/_parent]} mark]
     (if url
-     ; [:div {:class "bookmark_children" :key (str id "-key")}
-       [:div {:class "bookmark_link-icon" :aria-hidden "true" :key (str id "-icon-key")}
-        [:a {:on-click #(gwin/open url) :class "bookmark_link" :key (str id "-link-key")} name]
-        (when rating
-          (take rating
-                (repeat [:span {:class "bookmark_link-icon-rating" :aria-hidden "true"
-                                :key (str id "-rating-key")}])))];]
       [:div {:class "bookmark_children" :key (str id "-key")}
-       [:span {:class (str "bookmark_arrow" (when (not open?) "-collapsed"))
-               :key (str id "-arrow-key")
-               :on-click #(println "open?")}]
-       [:span {:class (str "bookmark_menu-icon-" (if open? "open" "close"))
-               :aria-hidden "true" :key (str id "-icon-key")
-               :on-click #(println "add")}]
-       [:span {:key (str id "-name-key") :on-click #(println "active")} name]
-       (when open? [:ul {:class "nav nav-pills nav-stacked":key (str id "-children-key")}
-                    (map #(bookmark %) _parent)])])))
+        [:div {:class "bookmark_link-icon" :aria-hidden "true" :key (str id "-icon-key")}]
+         [:a {:on-click #(gwin/open url) :class "bookmark_link" :key (str id "-link-key")} name]
+         (when rating
+           (take rating
+                 (repeat [:span {:class "bookmark_link-icon-rating" :aria-hidden "true"
+                                 :key (str id "-rating-key")}])))]
+      (let [{:keys [bookmark/_parent open?]} (session/get id)]
+        [:div {:class "bookmark_children" :key (str id "-key")}
+         [:span {:class (str "bookmark_arrow" (when (not open?) "-collapsed"))
+                 :key (str id "-arrow-key")
+                 :on-click #(do (println id "open?" open?)
+                                (if open? (session/update-in! [id :open?] (fn [_] (not open?)))
+                                          (session/assoc-in! [id :open?] true)))}]
+         [:span {:class (str "bookmark_menu-icon-" (if open? "open" "close"))
+                 :aria-hidden "true" :key (str id "-icon-key")
+                 :on-click #(println "add")}]
+         [:span {:key (str id "-name-key") :on-click #(session/put! :active id)} name]
+         (when open? [:ul {:class "nav nav-pills nav-stacked":key (str id "-children-key")}
+                      (doall (map #(bookmark %) _parent))])]))))
+
+;; -------------------------
+;; Views

 (defn home-page []
   [:div {:class "col-sm-12"}
    (header)
-   [:h2 "Welcome to bookmarx"]
+   (breadcrumbs)
    ;(str (:bookmark/_parent (session/get (session/get :active))))
-   (doall (map #(bookmark (:db/id %)) (:bookmark/_parent (session/get (session/get :active)))))
+   (doall (map #(bookmark %) (session/get-in [(session/get :active) :bookmark/_parent])))
    [:div [:a {:href "/about"} "go to about page"]]])

 (defn about-page []
@@ -121,7 +148,6 @@
             active (:db/id (first (filter #(nil? (:bookmark/parent %)) bookmarks)))]
         (session/put! :active active)
         (doall (map #(session/put! (:db/id %) %) bookmarks))
-        (println "active" (session/get :active))
         (accountant/configure-navigation!
           {:nav-handler (fn [path] (secretary/dispatch! path))
            :path-exists? (fn [path] (secretary/locate-route path))})


Jot down how I think initial rendering should work

Barely qualifies as a note, but it does compile.

--- src/cljs/frereth/world.cljs
+++ src/cljs/frereth/world.cljs
@@ -10,8 +10,9 @@
             [om.dom :as dom]
             [taoensso.timbre :as log]))

-;; FIXME: Debug only
-(enable-console-print!)
+(defn static-body
+  [data]
+  (om/component data))

 (defn world-wrapper
   [data owner]
@@ -38,14 +39,20 @@
                                (-> data keys  pr-str))
                     (if-let [body (:body active-world)]
                       (do
+                        (log/debug "Have a body")
                         (dom/div nil
                                  ;; This is really the background
                                  ;; Q: What does this part actually look like?
-                                 (om/build body (:state active-world))
+                                 (om/build static-body body)
                                  ;; TODO: Position this over that background
                                  ;; Although, honestly, there are a lot of times we won't need it.
                                  (dom/canvas #js {:id "view"})))
-                      (dom/canvas #js {:id "view"})))))
+                      ;; TODO: If there's a...what?
+                      ;; something like a renderer/body namespace attached to the compiled
+                      ;; script, treat that as a Component that we can om/build
+                      (do
+                        (log/debug "Falling back to just drawing a plain canvas")
+                        (dom/canvas #js {:id "view"}))))))
               (om/build repl/repl-wrapper (:repls data))))

     om/IDidMount


Simplify session testing so we do it once at startup and on any reconnects. That means reloading your browser no longer logs you out.

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -92,20 +92,19 @@
   (om/set-state! owner :session/state :secure))

 (defn test-session
-  "If we don't know the session state, ask the server for it."
+  "Ping the server to update the sesssion state."
   [owner]
-  (when (= :unknown (om/get-state owner :session/state))
-    (chsk-send! [:session/status])))
+  (chsk-send! [:session/status]))

 (defn event-loop
   "Handle inbound events."
   [app owner]
   (go (loop [[op arg] (<! ch-chsk)]
+        (println "-" op)
         (case op
           :chsk/recv (handle-event arg app owner)
           ;; we ignore other Sente events
-          nil)
-        (test-session owner)
+          (test-session owner))
         (recur (<! ch-chsk)))))

 (defn attempt-login


Add the pre-computation of the cells strength in the board

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -4,6 +4,8 @@
     [clojure.string :as str]))

 (enable-console-print!)
+
+;; TODO - Try to plug the history of brower for "back"

 ;; -----------------------------------------
@@ -16,19 +18,34 @@
 (def players [:blue :red :green])
 (def directions [[-1 0] [1 0] [0 -1] [0 1] [-1 1] [1 1] [-1 -1] [1 -1]])

-;; -----------------------------------------
-;; INIT THE BOARD
-;; -----------------------------------------
-
-(def empty-board
-  (let [column (vec (repeat board-height :empty))]
-    (vec (repeat board-width column))))
+
+;; -----------------------------------------
+;; UTILS
+;; -----------------------------------------
+
+(defn fast-max-key
+  "Fast max key that avoids recomputing things several times"
+  [key-fn coll]
+  (apply max-key (memoize key-fn) coll))

 (def all-positions
   (vec
     (for [x (range board-width)
           y (range board-height)]
       [x y])))
+
+(defn coord-neighbors
+  "All neighbors of a given coordinate"
+  [[x y]]
+  (map (fn [[dx dy]] [(+ x dx) (+ y dy)]) directions))
+
+;; -----------------------------------------
+;; INIT THE BOARD
+;; -----------------------------------------
+
+(def empty-board
+  (let [column (vec (repeat board-height :empty))]
+    (vec (repeat board-width column))))

 (defn draw-slices
   "Draw n * m slices from the collection"
@@ -120,10 +137,7 @@
     (transduce
       (available-moves-xf board)
       #(update-in %1 [(:winner %2) (:move %2)] conj %2)
-      {}
-      all-positions)
-    ))
-
+      {} all-positions)))

 ;; -----------------------------------------
 ;; ON PLAYER MOVE
@@ -173,14 +187,29 @@
 ;; ARTIFICIAL INTELLIGENCE
 ;; -----------------------------------------

-(defn fast-max-key
-  "Fast max key that avoids recomputing things several times"
-  [key-fn coll]
-  (apply max-key (memoize key-fn) coll))
+(defn compute-cell-strength
+  "Compute a cell strength based on the number of walls it has"
+  [board point]
+  (let [neighbors (coord-neighbors point)
+        walls (filter #(= :wall (get-in board % :wall)) neighbors)]
+    (+ 1 (* (count walls) 0.25))))
+
+(defn with-cells-strength
+  "Adds to a given game the strength of each of its cells"
+  [{:keys [board] :as game}]
+  (assoc game :cells-strength
+    (reduce
+      #(assoc %1 %2 (compute-cell-strength board %2))
+      {} all-positions)))
+
+#_(defn sum-strength
+   "Compute total strength of taking the provided cells"
+   [cells-strength taken-cells]
+   (transduce (map cells-strength) + taken-cells))

 (defn move-strength
   "Compute the strength of a move, based on the converted cells"
-  [converted-filter [move converted]]
+  [cells-strength converted-filter [move converted]]
   (transduce
     (comp
       (filter converted-filter)
@@ -193,7 +222,7 @@
   (let [converted-filter #(= looser (:looser %))
         all-moves (get-in game [:moves player])]
     (transduce
-      (map #(move-strength converted-filter %))
+      (map #(move-strength (:cells-strength game) converted-filter %))
       max all-moves)))

 (defn best-move
@@ -207,7 +236,7 @@
       (fast-max-key
         (fn [[m converted :as move]]
           (let [new-game (play-move game m)
-                diff-score (move-strength identity move)
+                diff-score (move-strength (:cells-strength game) identity move)
                 losses (map #(worst-immediate-loss new-game % player) others)]
             (- diff-score (apply max losses))))
         moves))
@@ -220,14 +249,15 @@

 (defn new-game []
   (with-available-moves
-    {:board (new-board)
-     :player (rand-nth players)
-     :moves {}
-     :help false
-     :scores
-     {:blue 12
-      :red 12
-      :green 12}}))
+    (with-cells-strength
+      {:board (new-board)
+       :player (rand-nth players)
+       :moves {}
+       :help false
+       :scores
+       {:blue 12
+        :red 12
+        :green 12}})))

 (defonce app-state (atom (new-game)))
 (def board (reagent/cursor app-state [:board]))


Fix no parenthesis around categories statement

--- src/verbose_spoon/model/queries.clj
+++ src/verbose_spoon/model/queries.clj
@@ -221,9 +221,9 @@
                     :else query-part)
         query-part (if (empty? categories)
                      query-part
-                     (str query-part (format (conj-where-or-and "Main_View.Category_Name = '%s' " "AND ") (first categories))))
+                     (str query-part (format (conj-where-or-and "(Main_View.Category_Name = '%s' " "AND ") (first categories))))
         categories (rest categories)
-        query-part (reduce #(str %1 (format (conj-where-or-and "Main_View.Category_Name = '%s' " "OR ") %2)) query-part categories)
+        query-part (str (reduce #(str %1 (format (conj-where-or-and "Main_View.Category_Name = '%s' " "OR ") %2)) query-part categories) ")")
         query-final (str query-part (conj-where-or-and "Main_View.Name LIKE '%") title "%'")
         query-results (concat dept-req-tuples (j/query mysql-db [query-final]))]
     (clojure.pprint/pprint query-final)


Some even less optimization for computing reduced contexts

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

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -313,8 +313,8 @@
   "Reduces context ctx assuming it is clarified."
   [ctx]
   (let [uda     (up-down-arrows ctx),
-        new-obj (set (map first uda)),
-        new-att (set (map second uda))]
+        new-obj (set-of g [[g _] uda]),
+        new-att (set-of m [[_ m] uda])]
     (make-context-nc new-obj new-att (incidence ctx))))

 (defn reduce-context-objects


Added implementation for shared intents

Added implementation for shared intents

by Stefan Borgwardt.

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

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -697,6 +697,38 @@
        (all-closed-sets (cross-product (objects ctx-1) (attributes ctx-2))
                         #(incidence (smallest-bond ctx-1 ctx-2 %)))))

+;;; Shared Intents (by Stefan Borgwardt)
+
+(defn- next-shared-intent
+  "The smallest shared intent of contexts ctx-1 and ctx-2 containing b."
+  [ctx-1 ctx-2 b]
+  (loop [shared-attrs b,
+         objs-1       (attribute-derivation ctx-1 b),
+         objs-2       (attribute-derivation ctx-2 b)]
+    (let [new-shared-attrs-1 (difference (object-derivation ctx-1 objs-1)
+                                         shared-attrs),
+          new-shared-attrs-2 (difference (object-derivation ctx-2 objs-2)
+                                         shared-attrs)]
+      (if (and (empty? new-shared-attrs-1) (empty? new-shared-attrs-2))
+        shared-attrs
+        (recur (union shared-attrs new-shared-attrs-1 new-shared-attrs-2)
+               (intersection objs-1 (attribute-derivation ctx-1 new-shared-attrs-2))
+               (intersection objs-2 (attribute-derivation ctx-2 new-shared-attrs-1)))))))
+
+(defn all-shared-intents
+  "All intents shared between contexts ctx-1 and ctx-2. ctx-1 and
+  ctx-2 must have the same attribute set."
+  [ctx-1 ctx-2]
+  (assert (= (attributes ctx-1) (attributes ctx-2)))
+  (all-closed-sets (attributes ctx-1) #(next-shared-intent ctx-1 ctx-2 %)))
+
+;; (defn all-bonds-by-shared-intents
+;;   "All bonds between ctx-1 and ctx-2, computed using shared intents."
+;;   [ctx-1 ctx-2]
+;;   (map #(make-context (objects ctx-1) (attributes ctx-2) %)
+;;        (all-shared-intents (context-product (adiag-context (objects ctx-1)) ctx-2)
+;;                            (dual-context (context-product ctx-1 (adiag-context (attributes ctx-2)))))))
+
 ;;;

 nil


Re-enable install/setup

Re-enable install/setup

--- src/copycat_jepsen/core.clj
+++ src/copycat_jepsen/core.clj
@@ -31,7 +31,7 @@
   "Installs copycat on the given node."
   [node version]

-  ; Setup Jepsen users not using copycat-jepsen's Docker container
+  ; Setup for non copycat-jepsen Docker environments
   (when (nil? (debian/installed-version "oracle-java8-installer"))
     (info node "installing JDK")
     (c/su
@@ -43,20 +43,19 @@
     (debian/install ["oracle-java8-installer" "oracle-java8-set-default" "git" "maven"]))

   ; Install copycat
-  ;(c/su
-  ;  (info node "fetching copycat")
-  ;  (if-not (cutil/dir-exists "/opt/copycat")
-  ;    (c/cd "/opt"
-  ;          (c/exec :git :clone "https://github.com/kuujo/copycat.git"))
-  ;    (c/cd "/opt/copycat"
-  ;          (c/exec :git :pull)))
-  ;  (info node "building copycat")
-  ;  (c/cd "/opt/copycat"
-  ;        ;(c/exec :git :checkout "0.6.0")
-  ;        (c/exec :mvn :clean :install "-DskipTests=true"))
-  ;  (c/cd "/opt/copycat/examples"
-  ;        (c/exec :mvn :clean :package)))
-  )
+  (c/su
+    (info node "fetching copycat")
+    (if-not (cutil/dir-exists "/opt/copycat")
+      (c/cd "/opt"
+            (c/exec :git :clone "https://github.com/kuujo/copycat.git"))
+      (c/cd "/opt/copycat"
+            (c/exec :git :pull)))
+    (info node "building copycat")
+    (c/cd "/opt/copycat"
+          (c/exec :git :checkout)
+          (c/exec :mvn :clean :install "-DskipTests=true"))
+    (c/cd "/opt/copycat/examples"
+          (c/exec :mvn :clean :package))))

 (defn start!
   "Starts copycat."


Add latency graph to Jepsen checkers.

Add latency graph to Jepsen checkers.

--- src/copycat_jepsen/core.clj
+++ src/copycat_jepsen/core.clj
@@ -206,6 +206,9 @@
     (merge base-test
            {:client    (cas-register-client (:node-set base-test))
             :model     (model/cas-register)
+            :checker   (checker/compose {:linear checker/linearizable
+                                         :latency (checker/latency-graph
+                                                    "report/")})
             :generator (->> gen/cas
                             (gen/delay 1/2)
                             std-gen)}


updated kokken importer

updated kokken importer

--- src/corpus_utils/kokken.clj
+++ src/corpus_utils/kokken.clj
@@ -57,7 +57,13 @@
    number :- s/Str
    filename :- java.io.File
    article-loc :- ZipperLocation]
-  (let [[title author title-alt style genre] ((juxt :題名 :著者 :欄名 :文体 :ジャンル) (:attrs (fz/node article-loc)))]
+  (let [attrs (:attrs (fz/node article-loc))
+        title (or (:題名 attrs) (:title attrs) "")
+        author (or (:著者 attrs) (:author attrs) "")
+        title-alt (:欄名 attrs)
+        style (or (:文体 attrs) (:style attrs))
+        script (or (:script attrs) "漢字かな") ;; TODO This can be a corpus-level attribute too. Meiroku is at this level, though. Is this a good default? Should keywordize this!
+        genre (or (:ジャンル attrs) "")]
     {:paragraphs
      (->> article-loc
           fz/down
@@ -66,15 +72,18 @@
           ;;(take 2)
           (mapcat partition-by-paragraph)
           (map (fn [text] {:tags #{}
-                          :sentences text}))
+                           :sentences text}))
           (into []))
      :metadata
      {:title     title
       :author    author
       :publisher corpus
-      :year      (Integer/parseInt year)
+      :year      (try (Integer/parseInt year)
+                      (catch Exception e
+                        (println "Caught exception: " e)))
       :basename  (fs/base-name filename ".xml")
       :corpus    corpus
+      :script    script
       :category  [(get ndc-map (str/replace genre #"^NDC" "") "分類なし")]}}))

 (s/defn parse-document-seq :- [DocumentSchema]
@@ -84,7 +93,10 @@
                      io/input-stream
                      xml/parse
                      fz/xml-zip)
-        [corpus year number] ((juxt :雑誌名 :年 :号) (-> root-loc fz/node :attrs ))]
+        attrs (-> root-loc fz/node :attrs)
+        [corpus year number] [(get attrs :雑誌名 (:title attrs))
+                              (get attrs :年 (:year attrs))
+                              (get attrs :号 (:issue attrs))]]
     (->> root-loc
          fz/down ;; Descend to the :記事 level.
          fz/rights
@@ -97,6 +109,3 @@
   [options :- {:corpus-dir s/Str s/Keyword s/Any}]
   (->> (fs/glob (str (:corpus-dir options) "/*.xml"))
        (mapcat parse-document-seq)))
-
-(comment
-  (s/with-fn-validation (parse-document-seq "/data/taiyo-corpus/XML/t189506.xml")))


Code cleanup

Code cleanup

--- ccw.core/src/ccw/util/executable_extension_factory.clj
+++ ccw.core/src/ccw/util/executable_extension_factory.clj
@@ -1,2 +0,0 @@
-(ns ccw.util.executable-extension-factory)
-


fix: clean processing on download error

fix: clean processing on download error

--- src/gml_to_featured/api.clj
+++ src/gml_to_featured/api.clj
@@ -105,7 +105,8 @@
   (swap! stats update-in [:queued] pop)
   (let [result (download-file file)]
      (if (:download-error result)
-       (stats-on-callback callback-chan request (assoc request :error (:download-error result)))
+       (do (swap! stats assoc-in [:processing worker-id] nil)
+           (stats-on-callback callback-chan request (assoc request :error (:download-error result))))
        (let [process-result (process-downloaded-xml2json-data dataset mapping validity (:zipped result) (:file result) (extract-name-from-uri file))]
          (fs/safe-delete (:file result))
          (swap! stats assoc-in [:processing worker-id] nil)


improved crowbar puzzle

improved crowbar puzzle

--- src/house/rooms/garden.cljc
+++ src/house/rooms/garden.cljc
@@ -11,6 +11,7 @@
               (room/add-item (item/make ["creeping fig" "fig"] "It was a bit more under control than on the other side." :climb-up "The fig wasn't strong enough to climb up on this side of the wall.") "")
               (room/add-item (item/make ["path" "stone path"] "It led back to the house.") "A stone path led south to the back entrance of the house.")
               (room/add-item (item/make ["shed" "wooden shed"] "It looked a bit neglected." :enter :shed) "There was an old wooden shed on the east corner.")))
+

 (defn crow-pre
   "If trying to open the back door do it, otherwise default message."
@@ -28,15 +29,26 @@
                             :open true
                             :enter :back-hall3)
         new-map (room/connect (:room-map gs) :house-back :south :back-hall3)]
-    (utils/say "Easy job for the crowbar. The door was now open.")
     (-> gs
       (assoc :room-map new-map)
       (utils/replace-item door new-door))))

+; FIXME need to cover case use with screw and use with hammer, screwdriver
+; FIXME unlock with crowbar is sort of funny, but open with isn't, it should work! --> probably best to separate verbs
+(def back-door (item/make ["door" "back door"]
+                          "It didn't look particularly tough."
+                          :break "Perhaps with the proper tooling."
+                          :enter "It was locked."
+                          :unlock {:say "Sure. I unlocked the hell out of it. The door was now open."
+                                   :post `crow-post} ; FIXME so far not working
+                          :locked true))
+
 (def crowbar (item/make "crowbar" "satisfy all your breaking-into-places needs."
                         :take true
-                        :unlock "Unlock with a crowbar? That's one way to put it, I guess." ; FIXME this is working backwards
-                        :use-with {:pre `crow-pre :post `crow-post}))
+                        :unlocks back-door
+                        :use-with {:pre `crow-pre
+                                   :say "Easy job for the crowbar. The door was now open."
+                                   :post `crow-post}))

 (def screwdriver (item/make "screwdriver" "the dust and the rust were competing to see who'd take over the thing first."
                             :use-with "I didn't see any screws."
@@ -47,6 +59,8 @@
                        :use-with "Everything looking like a nail, huh?"))

 ; FIXME add drawer with screwdriver
+; FIXME add table
+; TODO custom text when opening the drawer
 (def shed (->
             (room/make "Shed"
                        "The shed was barely big enough for me to stand inside. There was a brief work table with a drawer against one of the walls and a tool board against the other. Right by the door was an old lawn mower."
@@ -59,14 +73,6 @@
             (room/add-item (item/make ["lawn mower" "mower"]
                                       "That thing surely had seen better days."
                                       :take "The lawn mower was too big to carry around, not to mention useless.") "")))
-
-; FIXME need to cover case use with screw and use with hammer, screwdriver
-; FIXME unlock with crowbar is sort of funny, but open with isn't, it should work! --> probably best to separate verbs
-(def back-door (item/make ["door" "back door"]
-                          "It didn't look particularly tough."
-                          :break "Perhaps with the proper tooling."
-                          :enter "It was locked."
-                          :locked true))

 (defn can-enter
   [gs]
@@ -81,9 +87,26 @@
                   (room/add-item (item/make "house" "It looked even bigger from this side."
                                                     :enter `can-enter
                                                     :break "Perhaps with the proper tooling."))))
+; TODO react to crowbar?
+(def bath-window (item/make "window"
+                            "It was too high to look inside from where I was standing."
+                            :look-in "It was too high to look inside from where I was standing."
+                            :open "I could reach the border of the window but not open it from the ground level."
+                            :use "I could reach the border of the window but not open it from the ground level."
+                            :enter "I could reach the border of the window but not open it from the ground level."
+                            :break "There was no need to do that."))
+(def west-passage (->
+                    (room/make "West passage"
+                               "The western passage ended up in a wall with a high window, probably of a bathroom.")
+                    (room/add-item bath-window "")))

-(def west-passage (room/make "West passage"
-                             " "))
-
-(def east-passage (room/make "East passage"
-                             " "))
+; TODO react to crowbar?
+(def east-passage (->
+                    (room/make "East passage"
+                               "The eastern passage ended up in the back of one of the bedrooms I saw from the street. It had a window.")
+                    (room/add-item (item/make "window"
+                                              "It was a woman’s bedroom by the look of the furniture. She was on a sofa, knitting. A man was reading next to her. They didn’t seem to pay much attention to each other."
+                                              :look-in "It was a woman’s bedroom by the look of the furniture. She was on a sofa, knitting. A man was reading next to her. They didn’t seem to pay much attention to each other."
+                                              :break "I didn't want to draw too much attention."
+                                              :enter "I didn't want to draw too much attention.")
+                                  "")))


Wrap layouts register in dosync.

Wrap layouts register in dosync.

--- src/incise/layouts/core.clj
+++ src/incise/layouts/core.clj
@@ -19,6 +19,8 @@

 (defn register
   "Register a layout function to a shortname"
-  [short-name layout-fn]
-  (swap! layouts
-         assoc (name short-name) layout-fn))
+  [short-names layout-fn]
+  (dosync
+    (doseq [short-name short-names]
+      (swap! layouts
+             assoc (name short-name) layout-fn))))


Remove call to flatten.

Remove call to flatten.

--- src/leiningen/classpath.clj
+++ src/leiningen/classpath.clj
@@ -1,6 +1,5 @@
 (ns leiningen.classpath
   (:use (clojure.contrib [io :only (file)]
-                         [seq-utils :only (flatten)]
                          [string :only (join)])
         [leiningen.checkout-deps :only [checkout-deps-paths]])
   (:import org.apache.tools.ant.types.Path))
@@ -22,12 +21,12 @@
 (defn get-classpath
   "Answer a list of classpath entries for PROJECT."
   [project]
-  (flatten [(:source-path project)
-            (:test-path project)
-            (:compile-path project)
-            (:resources-path project)
-            (find-lib-jars project)
-            (checkout-deps-paths project)]))
+  (concat [(:source-path project)
+           (:test-path project)
+           (:compile-path project)
+           (:resources-path project)]
+          (find-lib-jars project)
+          (checkout-deps-paths project)))

 (defn classpath
   "Print out the classpath in which the project operates, within the


make pinch-to-zoom with a trackpad work

make pinch-to-zoom with a trackpad work

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -1065,8 +1065,15 @@
                                  (let [dx (- (aget event "deltaX"))
                                        dy (aget event "deltaY")]
                                    (om/transact! camera (fn [c]
-                                                          (if (aget event "altKey")
-                                                            (cameras/set-zoom c (cameras/screen-event-coords event) (partial + (* -0.002 dy)))
+                                                          (if (or (aget event "altKey")
+                                                                  ;; http://stackoverflow.com/questions/15416851/catching-mac-trackpad-zoom
+                                                                  ;; ctrl means pinch-to-zoom
+                                                                  (aget event "ctrlKey"))
+                                                            (cameras/set-zoom c (cameras/screen-event-coords event)
+                                                                              (partial + (* -0.002
+                                                                                dy
+                                                                                ;; pinch-to-zoom needs a boost to feel natural
+                                                                                (if (.-ctrlKey event) 10 1))))
                                                             (cameras/move-camera c dx (- dy))))))
                                  (utils/stop-event event))}
                  (defs camera)


fix for changing mute icon name

fix for changing mute icon name

--- src-cljs/frontend/components/common.cljs
+++ src-cljs/frontend/components/common.cljs
@@ -257,7 +257,7 @@
           [:div.google-text "Sign in with Google"]])))))

 (defn volume-icon-kw [level]
-  (cond (= 0 level) :sound-mute
+  (cond (= 0 level) :sound-off
         (>= 10 level) :sound-min
         (>= 50 level) :sound-med
         :else :sound-max))


Clicking support opens mail link if elevio broken

--- src-cljs/frontend/components/common.cljs
+++ src-cljs/frontend/components/common.cljs
@@ -10,6 +10,7 @@
             [frontend.utils.github :as gh-utils]
             [frontend.utils.github :refer [auth-url]]
             [frontend.timer :as timer]
+            [frontend.elevio :as elevio]
             [goog.dom.DomHelper]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true])
@@ -20,11 +21,14 @@

 (defn contact-support-a-info [owner & {:keys [tags]
                                        :or {tags [:support-dialog-raised]}}]
-  (cond (not (config/elevio-enabled?)) {:href (str "mailto:" (config/support-email))
-                                        :target "_blank"}
-        user/free? {:href "https://discuss.circleci.com/t/community-support/1470"
-                    :target "_blank"}
-        :else {:on-click #(raise! owner tags)}))
+  (if user/support-eligible?
+    (if (or (elevio/broken?)
+            (not (config/elevio-enabled?)))
+      {:href (str "mailto:" (config/support-email))
+       :target "_blank"}
+      {:on-click #(raise! owner tags)})
+    {:href "https://discuss.circleci.com/t/community-support/1470"
+     :target "_blank"}))

 (defn contact-us-inner [owner]
   [:a (contact-support-a-info owner)


updated hello.input

updated hello.input

--- src/maqueta/hello/input.clj
+++ src/maqueta/hello/input.clj
@@ -2,7 +2,7 @@
 ;;;; http://jmonkeyengine.org/wiki/doku.php/jme3:beginner:hello_input_system

 (ns maqueta.hello.input
-  (:use (maqueta application assets))
+  (:use (maqueta application geometry))
   (:import (com.jme3.math ColorRGBA Vector3f)
            com.jme3.scene.Geometry
            com.jme3.scene.shape.Box))
@@ -14,12 +14,7 @@
       (doto (.setAccessible true))
       (.get app)))

-(def player (let [b (Box. Vector3f/ZERO 1 1 1)
-                  geo (Geometry. "Player" b)
-                  mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")]
-              (.setColor mat "Color" ColorRGBA/Blue)
-              (.setMaterial geo mat)
-              geo))
+(def player (make-box "Player" :x 1 :y 1 :z 1 :color ColorRGBA/Blue))

 (def is-running (atom true))

@@ -28,31 +23,30 @@
   (if (not key-pressed)
     (reset! is-running (not @is-running))))

-(defn rotate
-  [app value tpf]
-  (if @is-running
-    (.rotate player 0 (* value (get-speed app)) 0)
-    (println "Press P to unpause")))
+(defmacro def-pausable
+  [name & body]
+  `(defn ~name
+     [~'app ~'value ~'tpf]
+     (if @is-running
+       (do ~@body)
+       (println "Press P to unpause"))))

-(defn right
-  [app value tpf]
-  (if @is-running
-    (let [v (.getLocalTranslation player)]
-      (.setLocalTranslation player
-                            (+ (.getX v) (* value (get-speed app)))
-                            (.getY v)
-                            (.getZ v)))
-    (println "Press P to unpause")))
+(def-pausable rotate
+  (.rotate player 0 (* value (get-speed app)) 0))

-(defn left
-  [app value tpf]
-  (if @is-running
-    (let [v (.getLocalTranslation player)]
-      (.setLocalTranslation player
-                            (- (.getX v) (* value (get-speed app)))
-                            (.getY v)
-                            (.getZ v)))
-    (println "Press P to unpause")))
+(def-pausable right
+  (let [v (.getLocalTranslation player)]
+    (.setLocalTranslation player
+                          (+ (.getX v) (* value (get-speed app)))
+                          (.getY v)
+                          (.getZ v))))
+
+(def-pausable left
+  (let [v (.getLocalTranslation player)]
+    (.setLocalTranslation player
+                          (- (.getX v) (* value (get-speed app)))
+                          (.getY v)
+                          (.getZ v))))

 (defn -main
   [& args]
@@ -60,4 +54,4 @@
                     :on-action {:key-p toggle-pause}
                     :on-analog {:key-j left
                                 :key-k right
-                                '(:key-space :button-left) rotate})))
+                                [:key-space :button-left] rotate})))


Remove extraneous :as

Remove extraneous :as

--- test/eulalie/test/cognito_sync.cljc
+++ test/eulalie/test/cognito_sync.cljc
@@ -74,7 +74,7 @@
       (go-catching
         (<? (delete-datasets! creds))
         (let [params (test-params)
-              {token :sync-session-token :as x}
+              {token :sync-session-token}
               (<? (cognito-sync! creds :list-records params))
               {:keys [records]} (<? (update-records! creds token params))]
           (is (= 1 (count records)))


fixed an incorrectly named analytics event (#1659)

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -557,11 +557,11 @@
                                     #(do
                                        (raise! owner [:update-containers-clicked
                                                       {:containers selected-paid-containers}])
-                                       (analytics-track/track-update-plan-clicked {:owner owner
-                                                                                :new-plan selected-paid-containers
-                                                                                :previous-plan (pm/paid-linux-containers plan)
-                                                                                :plan-type pm/linux-plan-type
-                                                                                :upgrade? (> selected-paid-containers (pm/paid-linux-containers plan))})))
+                                       (analytics-track/update-plan-clicked {:owner owner
+                                                                             :new-plan selected-paid-containers
+                                                                             :previous-plan (pm/paid-linux-containers plan)
+                                                                             :plan-type pm/linux-plan-type
+                                                                             :upgrade? (> selected-paid-containers (pm/paid-linux-containers plan))})))
                         :kind :primary}
                        (if (config/enterprise?)
                          enterprise-text


fix log message

fix log message

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -414,7 +414,7 @@
                                  ;; technically a supervisor could still think there's an assignment and try to d/l
                                  ;; this will cause supervisor to go down and come back up... eventually it should sync
                                  ;; TODO: removing code locally should be done separately (since topology that doesn't start will still have code)
-                                 (log-message "Killing storm: " id)
+                                 (log-message "Killing topology: " id)
                                  (rmr (master-stormdist-root conf id))
                                  (.remove-storm! storm-cluster-state id)
                                  (recur (rest kill-order))


remove org-id fields from testing companies

--- test/open_company/lib/resources.clj
+++ test/open_company/lib/resources.clj
@@ -52,19 +52,16 @@
 (def open {
   :slug slug
   :name "OPENcompany"
-  :currency "USD"
-  :org-id "slack:98765"})
+  :currency "USD"})

 (def buffer {
   :slug "buffer"
   :name "Buffer"
-  :currency "USD"
-  :org-id "slack:42-hut-hut"})
+  :currency "USD"})

 (def uni {
   :name "$€¥£ &‼⁇ ∆∰≈ ☃♔☂Ǽ ḈĐĦ, LLC"
-  :currency "FKP"
-  :org-id "slack:98765"})
+  :currency "FKP"})

 ;; ----- Sections -----


Eliminate prepared statement cache, step 1

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -30,10 +30,6 @@
 (declare build-ssl-options)

 (def prepared-statement-cache (atom {}))
-
-(defn flush-prepared-statement-cache!
-  []
-  (reset! prepared-statement-cache {}))

 (defprotocol DummySession
   (executeAsync [_ query]))
@@ -129,14 +125,11 @@
 (defn ^Session connect
   "Connects to the Cassandra cluster. Use `build-cluster` to build a cluster."
   ([hosts]
-     (flush-prepared-statement-cache!)
      (.connect (build-cluster {:hosts hosts})))
   ([hosts keyspace]
-     (flush-prepared-statement-cache!)
      (let [c (build-cluster {:hosts hosts})]
        (.connect c (name keyspace))))
   ([hosts keyspace opts]
-     (flush-prepared-statement-cache!)
      (let [c (build-cluster (merge opts {:hosts hosts}))]
        (.connect c (name keyspace)))))


document and rename r-like-table to contingency-table for clarity

--- src/r_incantations/core.clj
+++ src/r_incantations/core.clj
@@ -138,7 +138,12 @@
     {:iana iana
      :av av}))

-(defn r-like-table [coll]
+(defn contingency-table
+  "Calculate a basic contingency table for the input collection, which
+   may contain items of any type.
+   C.f. incanter.stats/tabulate, which does more but is limited to
+   numeric matrices."
+  [coll]
   (let [n (incanter.core/nrow coll)
         p (incanter.core/ncol coll)]
     (loop [tab {} i (int 0)]


Use simple pipeline as default

Use simple pipeline as default

--- backend/test/lambdaui/testpipeline/core.clj
+++ backend/test/lambdaui/testpipeline/core.clj
@@ -40,14 +40,14 @@
         long-running-pipeline (lambdacd/assemble-pipeline long-running-pipe/pipeline-structure {:home-dir (util/create-temp-dir) :name "LONG-RUNNING PIPELINE"})
         artifact-pipeline (lambdacd/assemble-pipeline artifact-pipeline/pipeline-structure {:home-dir "/tmp/moinsen" :artifacts-path-context artifacts-path-context :name "ARTIFACT PIPELINE"})]

-    (reset! current-pipeline artifact-pipeline)
+    (reset! current-pipeline simple-pipeline)

     (reset! server

             (let [routes

                   (routes
-                    (ui/ui-for artifact-pipeline :showStartBuildButton true)
+                    (ui/ui-for simple-pipeline :showStartBuildButton true)
                     (context artifacts-path-context [] (artifacts/artifact-handler-for artifact-pipeline))

                     (context "/long-running" []


Fix bug where peer doesn't return it's state when evicting

--- src/onyx/log/commands/prepare_join_cluster.clj
+++ src/onyx/log/commands/prepare_join_cluster.clj
@@ -112,7 +112,8 @@
              (extensions/write-log-entry
                (:log state)
                {:fn :leave-cluster :args {:id target}
-                :entry-parent message-id})))
+                :entry-parent message-id}))
+           state)

          (= (:id state) (:observer diff))
          (let [ch (chan 1)]


add field page_type to mapping

add field page_type to mapping

--- src/wb_es/mappings/core.clj
+++ src/wb_es/mappings/core.clj
@@ -34,6 +34,8 @@
     :other_names {:type "string"
                   :include_in_all false
                   :analyzer "keyword_ignore_case"}
+    :page_type {:type "string"
+                :analyzer "keyword_ignore_case"}
     :paper_type {:type "string"
                  :analyzer "keyword_ignore_case"}
     :species {:properties


Hide community banner

Hide community banner

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

--- src/status_im/ui/screens/home/views.cljs
+++ src/status_im/ui/screens/home/views.cljs
@@ -20,6 +20,7 @@
             [status-im.ui.screens.add-new.new-public-chat.db :as db]
             [status-im.utils.debounce :as debounce]
             [status-im.utils.utils :as utils]
+            [status-im.utils.config :as config]
             [cljs-bean.core :as bean]
             [status-im.multiaccounts.login.core :as multiaccounts.login]
             [status-im.ui.components.invite.views :as invite]
@@ -82,13 +83,15 @@
      [react/view {:flex-direction :row :flex-wrap :wrap :justify-content :center}
       (for [chat (new-public-chat/featured-public-chats)]
         (new-public-chat/render-topic chat))]]
-    [react/i18n-text {:style {:margin-horizontal 16
-                              :text-align        :center}
-                      :key   :join-a-community}]
-    [react/view {:style styles/tags-wrapper}
-     [react/view {:flex-direction :row :flex-wrap :wrap :justify-content :center}
-      (for [community communities/featured]
-        (communities.views/render-featured-community community))]]]])
+    (when config/communities-enabled?
+      [react/view
+       [react/i18n-text {:style {:margin-horizontal 16
+                                 :text-align        :center}
+                         :key   :join-a-community}]
+       [react/view {:style styles/tags-wrapper}
+        [react/view {:flex-direction :row :flex-wrap :wrap :justify-content :center}
+         (for [community communities/featured]
+           (communities.views/render-featured-community community))]]])]])

 (defn welcome-blank-page []
   [react/view {:style {:flex 1 :flex-direction :row :align-items :center :justify-content :center}}


Re-jigged as this generates non-terminating clojurescript :-|

--- src/wireframes/renderer.clj
+++ src/wireframes/renderer.clj
@@ -42,12 +42,13 @@
         (loop [acc    0.0
                count  0
                points polygon]
-          (if-let [[_ _ ^double z] (get points-3d (first points))]
-            (recur
-              (- acc z)
-              (inc count)
-              (rest points))
-            (/ acc count)))))))
+          (if (empty? points)
+            (/ acc count)
+            (let [[_ _ ^double z] (get points-3d (first points))]
+              (recur
+                (- acc z)
+                (inc count)
+                (rest points)))))))))

 (defn get-3d-points [transform shape]
   (mapv


move cider to :repl profile instead of :user

--- home/.lein/profiles.clj
+++ home/.lein/profiles.clj
@@ -1,6 +1,6 @@
-{:user {:plugins [[refactor-nrepl "2.0.0-SNAPSHOT"]
-                  [cider/cider-nrepl "0.11.0-SNAPSHOT"]]
-        :dependencies [[org.clojure/tools.nrepl "0.2.12"]]}}
+{:repl {:dependencies [[org.clojure/tools.nrepl "0.2.12"]]
+        :plugins [[refactor-nrepl "2.0.0-SNAPSHOT"]
+                  [cider/cider-nrepl "0.11.0-SNAPSHOT"]]}}


Fix compilation error.

Fix compilation error.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -59,9 +59,10 @@
    (from-file file :sha2-256))
   ([file algorithm]
    (let [file (io/file file)
-         hash-fn (checked-hash algorithm)
-         id (hash-fn (io/input-stream file))]
-     (data/lazy-block id (.length content) #(io/input-stream file)))))
+         hash-fn (data/checked-hash algorithm)
+         reader #(io/input-stream file)
+         id (hash-fn (reader))]
+     (data/lazy-block id (.length file) reader))))

 (defn read!


get-camera!

get-camera!

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -194,30 +194,33 @@
           (recur (inc tick)))))))

-(defonce gum (take! (media/get-media) (fn [{:keys [status data]}]
-  (if (= status :success)
-    (let [video  (.createElement js/document "video")
-          canvas (.createElement js/document "canvas")]
-      (aset canvas "width" capture-size)
-      (aset canvas "height" capture-size)
-      (aset video "autoplay" "autoplay")
-      (aset video "onplaying" (fn []
-        (let [vw (.-videoWidth video)
-              vh (.-videoHeight video)]
-          (js-delete video "onplaying")
-          (swap! app-state merge {
-            :stream      data
-            :grid-px     (get-max-grid-px)
-            :vid-node    video
-            :vid-w       vw
-            :vid-h       vh
-            :vid-ratio   (/ vw vh)
-            :vid-offset  (* 100 (/ (max 1 (.abs js/Math (- vw vh))) (max 1 (* vw 2))))
-            :canvas-node canvas
-            :ctx         (.getContext canvas "2d")})
-          (js/setTimeout start! 500))))
-      (aset video "src" data))
-    (swap! app-state assoc :media-error? true)))))
+(defn get-camera! []
+  (take! (media/get-media) (fn [{:keys [status data]}]
+    (if (= status :success)
+      (let [video  (.createElement js/document "video")
+            canvas (.createElement js/document "canvas")]
+        (doto canvas
+          (aset "width"  capture-size)
+          (aset "height" capture-size))
+        (doto video
+          (aset "autoplay" "autoplay")
+          (aset "onplaying" (fn []
+            (let [vw (.-videoWidth video)
+                  vh (.-videoHeight video)]
+              (js-delete video "onplaying")
+              (swap! app-state merge {
+                :stream      data
+                :grid-px     (get-max-grid-px)
+                :vid-node    video
+                :vid-w       vw
+                :vid-h       vh
+                :vid-ratio   (/ vw vh)
+                :vid-offset  (* 100 (/ (max 1 (.abs js/Math (- vw vh))) (max 1 (* vw 2))))
+                :canvas-node canvas
+                :ctx         (.getContext canvas "2d")})
+              (js/setTimeout start! 500))))
+          (aset "src" data)))
+      (swap! app-state assoc :media-error? true)))))

 (om/root


debugging problem in find-castlings

debugging problem in find-castlings

--- src/chess/board.clj
+++ src/chess/board.clj
@@ -127,15 +127,20 @@
         kings-transfer (indexes-between (rules :from) (rules :to))
         rooks-transfer (indexes-between (rules :rook-from) (rules :rook-to))]
     (when (and
-        (get castling-rights castling-type)
-        ;(every? (partial empty-square? board) kings-transfer)
+        (contains? castling-rights castling-type)
+        (every? (partial empty-square? board) kings-transfer)
         ;(every? (partial empty-square? board) rooks-transfer)
         ;(empty? (clojure.set/intersection attacked-indexes-by-opponent kings-transfer))
         )
-      (assoc (rules castling-type) :type castling-type))))
+      castling-type))
+)
+;      (assoc (rules castling-type) :type castling-type))))

 (defn find-castlings [board turn castling-rights]
   (map (partial check-castling board turn castling-rights) (castlings turn)))
+
+(find-castlings (place-pieces [:K :e1 :R :a1 :R :h1]) :white #{:O-O :O-O-O})
+

 ;


atom init value changed

atom init value changed

--- src/ads/helpers.clj
+++ src/ads/helpers.clj
@@ -23,6 +23,6 @@

 (defn register-new-request-to-counter [req]
   (let [uri (:uri req)]
-    (get (swap! counter assoc uri (inc (get @counter uri 1))) uri)
+    (get (swap! counter assoc uri (inc (get @counter uri 0))) uri)
     ))


Use lazy FASTA reading in dict creation

Use lazy FASTA reading in dict creation

--- src/cljam/fasta.clj
+++ src/cljam/fasta.clj
@@ -62,19 +62,9 @@
   "fasta -> dict"
   [fasta out-dict]
   (let [ur (.toString (.toURI (file fasta)))]
-   (with-open [r (clojure.java.io/reader fasta)
+   (with-open [r (reader fasta)
                w (writer out-dict)]
-     (.write w "@HD\tVN:" sam/version "\tSO:unsorted")
+     (.write w (str "@HD\tVN:" sam/version "\tSO:unsorted"))
      (.newLine w)
-     (loop [line (.readLine r)
-            ref nil
-            seq nil]
-       (if (nil? line)
-         (when-not (nil? ref)
-           (write-sq w ref seq ur))
-         (if (= (first line) \>)
-           (do
-             (when-not (nil? ref)
-               (write-sq w ref seq ur))
-             (recur (.readLine r) (subs line 1) nil))
-           (recur (.readLine r) ref (str seq line))))))))
+     (doseq [sq (read r)]
+       (write-sq w (:ref sq) (:seq sq) ur)))))


Remove link file if it exists before creating link

--- boot/pod/src/boot/file.clj
+++ boot/pod/src/boot/file.clj
@@ -142,6 +142,7 @@

 (defn hard-link
   [^File existing-file ^File link-file]
+  (Files/deleteIfExists (.toPath link-file))
   (Files/createLink (.toPath link-file) (.toPath existing-file)))

 (defn sym-link


Change log to warn for no prestashed tickets. (#846)

--- waiter/src/waiter/auth/kerberos.clj
+++ waiter/src/waiter/auth/kerberos.clj
@@ -101,7 +101,8 @@
                         {:message (utils/message :prestashed-tickets-not-available)
                          :service-id service-id
                          :status 403
-                         :user run-as-user}))))))
+                         :user run-as-user
+                         :log-level :warn}))))))

 (defrecord KerberosAuthenticator [^ThreadPoolExecutor executor max-queue-length password]
   auth/Authenticator


Fix typo

Fix typo

--- src/gol/core/act.cljs
+++ src/gol/core/act.cljs
@@ -14,7 +14,7 @@

 (defn- toggle-cell
   [state {:keys [loc]}]
-  (let [{{population :popuplation} :universe} @state]
+  (let [{{population :population} :universe} @state]
     (swap! state assoc-in [:universe :population] (if (population loc) (disj population loc) (conj population loc)))))

 (defn- change-period


(MAINT) Fix repl per break in SERVER-813

This commit fixes the user_repl.clj, previously broken by changes
introduced in SERVER-813.  The primary change in the commit is to rename
`pool->vec` to `registered-instances` per the name change made as part
of the work on that ticket.  The commit also includes some web-routing
and puppet-admin sections missing from the sample repl configuration.

--- dev/user_repl.clj
+++ dev/user_repl.clj
@@ -39,7 +39,12 @@
      :webserver             {:client-auth "want"
                              :ssl-host    "localhost"
                              :ssl-port    8140}
-     :certificate-authority {:certificate-status {:client-whitelist []}}}))
+     :certificate-authority {:certificate-status {:client-whitelist []}}
+     :web-router-service    {:puppetlabs.services.ca.certificate-authority-service/certificate-authority-service ""
+                             :puppetlabs.services.master.master-service/master-service ""
+                             :puppetlabs.services.puppet-admin.puppet-admin-service/puppet-admin-service "/puppet-admin-api"}
+     :puppet-admin          {:client-whitelist       []
+                             :authorization-required false}}))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Basic system life cycle
@@ -102,7 +107,7 @@
 (defn jruby-pool
   "Returns a reference to the current pool of JRuby interpreters."
   []
-  (jruby-core/pool->vec (context [:JRubyPuppetService :pool-context])))
+  (jruby-core/registered-instances (context [:JRubyPuppetService :pool-context])))

 (defn puppet-environment-state
   "Given a JRuby instance, return the state information about the environments


Added the 'wrap-spy' custom handler from that one blog post; it automatically outputs pretty-printed Request and Response maps in the server console. Confirmed working.

--- src/blaagh/core.clj
+++ src/blaagh/core.clj
@@ -3,6 +3,8 @@
             [org.httpkit.server :refer [run-server]]
             [ring.middleware.reload :as reload]
             [ring.middleware.defaults :refer :all]))
+
+(require 'clojure.pprint)

 (defn home-handler
     [request]
@@ -11,6 +13,18 @@
 (defn wrap-version [handler]
     (fn [request]
         (handler (assoc request :app-version "0.1"))))
+
+(defn wrap-spy [handler]
+    ""
+    (fn [request]
+        (println "-------------------------------")
+        (println "Incoming Request Map:")
+        (clojure.pprint/pprint request)
+        (let [response (handler request)]
+            (println "Outgoing Response Map:")
+            (clojure.pprint/pprint response)
+            (println "-------------------------------")
+            response)))

 (defroutes all-routes
     (GET "/" [request] home-handler)
@@ -23,5 +37,9 @@
     (HEAD "/" [] "Preview something"))

 (defn -main []
-    (run-server (reload/wrap-reload (wrap-version #'all-routes)) {:port 5000}))
+    (run-server
+        (reload/wrap-reload
+            (wrap-spy
+                (wrap-version #'all-routes))) {:port 5000}))
+                    ; (wrap-defaults #'all-routes site-defaults)))) {:port 5000}))
     ; (run-server (reload/wrap-reload #'all-routes) {:port 5000}))


Removed symbol-name function

Removed symbol-name function

--- parser/parser.clj
+++ parser/parser.clj
@@ -1,8 +1,3 @@
-
-(def symbol-name (symbol)
-     (match symbol
-            (Symbol name _)  name
-            _                Empty))

 (def symbol-to-string (symbol)
      (match symbol
@@ -198,13 +193,15 @@
                  (sexp-to-arguments (pair-left body))))
                  (sexp-to-function-body range rest)))

-(def sexp-to-definition' (kind name rest range)
-     (match (type-definition? (symbol-name kind))
-            True   (sexp-to-type-definition name rest range)
-            False
-     (match (function-definition? (symbol-name kind))
-            True   (sexp-to-function-definition name rest range)
-            False  (Error (MalformedDefinitionError range)))))
+(def sexp-to-definition' (kind-symbol name rest range)
+     (result-flatmap (fn (kind)
+                         (match (type-definition? kind)
+                                True   (sexp-to-type-definition name rest range)
+                                False
+                         (match (function-definition? kind)
+                                True   (sexp-to-function-definition name rest range)
+                                False  (Error (MalformedDefinitionError range)))))
+                     (symbol-to-string kind-symbol)))

 (def sexp-to-definition (expression)
      (match expression


Trying out state atom

Trying out state atom

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -1,25 +1,35 @@
 (ns korhal.core
-  (:import (jnibwapi.JNIBWAPI)
-           (jnibwapi.BWAPIEventListener)
-           (jnibwapi.model.Unit)
-           (jnibwapi.util.BWColor)))
+  (:import (jnibwapi JNIBWAPI BWAPIEventListener)
+           (jnibwapi.model Unit)
+           (jnibwapi.util BWColor)))

 (gen-class
  :name "korhal.core"
- :implements [jnibwapi.BWAPIEventListener]
- :state "state"
+ :implements [JNIBWAPI]
+ :state state
  :main true
  :constructors {[] []}
  :prefix "korhal-")

 (defn korhal-main [& args]
-  (let [ai (new korhal.core)]
-    (.start (jnibwapi.JNIBWAPI. ai))))
+  (let [ai (new korhal.core)
+        api (JNIBWAPI. ai)]
+    (compare-and-set! (.state ai) @(.state ai) (merge @(.state ai) {:api api}))
+    (.start api))))

-(defn korhal-init [this] [[] "state"])
+(defn korhal-init [this]
+  [[] (atom {})])

 (defn korhal-connected [this])
-(defn korhal-gameStarted [this])
+
+(defn korhal-gameStarted [this]
+  (println "Here we go!")
+  (doto (:api @(.state this))
+    (.enableUserInput)
+    (.enablePerfectInformation)
+    (.setGameSpeed 0)
+    (.loadMapData true)))
+
 (defn korhal-gameUpdate [this])
 (defn korhal-gameEnded [this])
 (defn korhal-keyPressed [this keycode])


Factored main logic out of html macro

Factored main logic out of html macro

--- src/hiccup.clj
+++ src/hiccup.clj
@@ -73,7 +73,7 @@
 (defn render-content
   "Render the contents of a tag."
   [content]
-  (list*
+  (cons
     ">"
     (render-html
       (if (map? (first content))
@@ -107,6 +107,14 @@
            (not (symbol? x)))
       (quoted? x)))

+(derive clojure.lang.IPersistentList ::form)
+(derive clojure.lang.Symbol ::form)
+
+(defmulti compile-html
+  "Render a Clojure data structure to a seq of HTML at compile-time when
+  possible, at runtime when not."
+  type)
+
 (defn- collapse-strs
   "Concatenate adjacent strings in a sequence."
   [coll]
@@ -118,63 +126,45 @@
     '()
     (reverse coll)))

-(defn build-seq
-  "Create code that will build an output seq from a list of literals and
-  forms."
+(defn compile-seq
+  "Compile a sequence of Clojure data structures into HTML"
   [coll]
-  (let [coll (collapse-strs coll)]
-    (if (every? literal? coll)
-      coll
-     `((concat ~@(for [x coll]
-                   (if (literal? x)
-                     `(list ~x)
-                      x)))))))
-
-(defn wrap-list
-  "Wrap a seq in an `list form if a bare list."
-  [coll]
-  (if (symbol? (first coll))
-    coll
-    `(list ~@coll)))
-
-(derive clojure.lang.IPersistentList ::form)
-(derive clojure.lang.Symbol ::form)
-
-(defmulti compile-html
-  "Render a Clojure data structure to a seq of HTML at compile-time when
-  possible, at runtime when not."
-  type)
+  (let [forms (collapse-strs (mapcat compile-html coll))]
+    (if (every? literal? forms)
+      `(list ~@forms)
+      `(concat ~@(for [form forms]
+                   (if (literal? form)
+                     `(list ~form)
+                     form))))))

 (defn compile-tag
   "Attempt to pre-render a HTML tag."
   [tag-name content]
   (if (literal? tag-name)
     (render-tag tag-name content)
-   `((render-tag ~tag-name ~content))))
+   `(render-tag ~tag-name ~(compile-seq content))))

 (defn compile-attrs
   "Attempt to pre-render an attribute map."
   [attrs content]
   (if (map? attrs)
     (render-attrs attrs content)
-    (if (not (literal? attrs))
-     `((render-attrs ~attrs ~(wrap-list content)))
+    (if-not (literal? attrs)
+     `((render-attrs ~attrs ~(compile-seq content)))
       content)))

 (defn compile-content
   "Attempt to pre-render the contents of a tag."
   [content]
-  (build-list
-    (cons
-      ">"
-      (if (map? (first content))
+  (cons
+    ">"
+    (cond
+      (map? (first content))
         (mapcat compile-html (rest content))
-        (if (literal? (first content))
-          (mapcat compile-html content)
-          (concat
-            (for [x (take 2 content)]
-              `(render-html ~x))
-            (map compile-html (drop 2 content))))))))
+      (literal? (first content))
+        (mapcat compile-html content)
+      :else
+        (list "blah"))))

 (defmethod compile-html ::vector
   [[tag & content]]
@@ -184,9 +174,7 @@

 (defmethod compile-html ::form
   [form]
-  (if (quoted? form)
-    `((render-html ~(rest form)))
-    `((render-html ~form))))
+  `((render-html ~form)))

 (defmethod compile-html :default
   [x]
@@ -195,4 +183,4 @@
 (defmacro html
   "Efficiently render a Clojure data structure into a seq of HTML."
   [& content]
-  (wrap-list (build-list (mapcat compile-html content))))
+  (compile-seq content))


Clean up.

Clean up.

--- clj_record/query.clj
+++ clj_record/query.clj
@@ -4,8 +4,8 @@

 (defn- generate-predicate-fn [predicate join-predicate-params-with values]
   (fn [attribute]
-     (let [[clause params]
-	   [(str-utils/str-join join-predicate-params-with
+     (let [[clause params]
+           [(str-utils/str-join join-predicate-params-with
              (reduce
                (fn [predicate-params value]
                  (conj predicate-params (if (nil? value) "NULL" "?"))) [] values))


missing volumes arent deleted by default

--- src/aws/volumes.clj
+++ src/aws/volumes.clj
@@ -48,7 +48,9 @@
    "is this ebs clearable"
    [device-name system-id]
   (let [{:keys [volumes]} ((s/get-system system-id) :aws)]
-    ((first (filter (fn [{:keys [device]}] (= device device-name)) volumes)) :clear)))
+    (if-let [e (first (filter (fn [{:keys [device]}] (= device device-name)) volumes))]
+       (e :clear)
+       false)))

 (defn delete-volumes
   "Clear instance volumes"


optimize (moreover-comp): check candidate complement's :cat before doing unification

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -157,10 +157,13 @@
   (log/trace (str "moreover-comp type comp:" (type child)))

   (let [result
-        (unify (copy parent)
-               (unifyc {:comp child}
-                       {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}}))]
-
+        (if (and *check-parent-and-head-child-cat-equal*
+                 (not (= (get-in parent [:comp :synsem :cat])
+                         (get-in child [:synsem :cat]))))
+          :fail
+          (unify (copy parent)
+                 (unifyc {:comp child}
+                         {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}})))]
     (if (not (fail? result))
       (let [debug (log/debug (str "moreover-comp: [" (get-in parent [:rule]) " C: "
                                   (if (get-in child [:rule])


Fn for adding and removing seedings

Fn for adding and removing seedings

--- server/src/spira/dm/garden.clj
+++ server/src/spira/dm/garden.clj
@@ -20,6 +20,18 @@
 ;; Garden factory
 (defn create-garden [name]
   (->Garden name []))
+
+(defn add-seeding [g s]
+  "Add a seeding to a garden"
+  (update-in g [:seedings] conj s))
+
+(defn- rm-seeding-impl [seedings sid]
+  "Given a list of seedings, remove the one with a matching id"
+  (remove (fn [{id :id}] (= id sid)) seedings))
+
+(defn rm-seeding [g id]
+  "Remove a seeding from a garden"
+  (update-in g [:seedings] rm-seeding-impl id))

 ;; Garden repository
 (defprotocol GardenRepo


Use :name instead of :gem

Use :name instead of :gem

--- src/hu/ssh/github_changelog/dependencies/bundler.clj
+++ src/hu/ssh/github_changelog/dependencies/bundler.clj
@@ -9,7 +9,7 @@
        (take-while seq)))

 (defn- parse-spec [spec]
-  {:gem (second spec) :version (nth spec 2)})
+  {:name (second spec) :version (nth spec 2)})

 (defn- parse-specs [specs]
   (->> (map #(re-matches #"^\s{4}(\S+) \((.*)\)$" %) specs)


Move metering into blocks.core wrappers.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -11,9 +11,10 @@
   - `:source`      resource location for the block content
   - `:stored-at`   time block was added to the store
   "
-  (:refer-clojure :exclude [get list sync])
+  (:refer-clojure :exclude [get list])
   (:require
     [blocks.data :as data]
+    [blocks.meter :as meter]
     [blocks.store :as store]
     [blocks.summary :as sum]
     [byte-streams :as bytes]
@@ -170,6 +171,14 @@
   (store/initialize uri))

+(defmacro ^:private measure-method
+  "Anophoric macro to measure a store method."
+  [[method-kw args] & body]
+  `(meter/measure-method*
+     ~'store ~method-kw ~args
+     (fn body# [] ~@body)))
+
+
 (defn stat
   "Returns a map with an `:id` and `:size` but no content. The returned map
   may contain additional data like the date stored. Returns nil if the store
@@ -179,7 +188,8 @@
     (when-not (instance? Multihash id)
       (throw (IllegalArgumentException.
                (str "Id value must be a multihash, got: " (pr-str id)))))
-    (store/-stat store id)))
+    (measure-method [::stat id]
+      (store/-stat store id))))

 (defn list
@@ -191,33 +201,34 @@
   - `:after`      list blocks whose id (in hex) lexically follows this string
   - `:limit`      restrict the maximum number of results returned
   "
-  ([store & opts]
-   (let [allowed-keys #{:algorithm :after :limit}
-         opts-map (cond
-                    (empty? opts) nil
-                    (and (= 1 (count opts)) (map? (first opts))) (first opts)
-                    :else (apply hash-map opts))
-         bad-opts (set/difference (set (keys opts-map)) allowed-keys)]
-     (when (not-empty bad-opts)
-       (throw (IllegalArgumentException.
-                (str "Invalid options passed to list: "
-                     (str/join " " bad-opts)))))
-     (when-let [algorithm (:algorithm opts-map)]
-       (when-not (keyword? algorithm)
-         (throw (IllegalArgumentException.
-                  (str "Option :algorithm is not a keyword: "
-                       (pr-str algorithm))))))
-     (when-let [after (:after opts-map)]
-       (when-not (and (string? after) (re-matches #"^[0-9a-fA-F]*$" after))
-         (throw (IllegalArgumentException.
-                  (str "Option :after is not a hex string: "
-                       (pr-str after))))))
-     (when-let [limit (:limit opts-map)]
-       (when-not (and (integer? limit) (pos? limit))
-         (throw (IllegalArgumentException.
-                  (str "Option :limit is not a positive integer: "
-                       (pr-str limit))))))
-     (store/-list store opts-map))))
+  [store & opts]
+  (let [allowed-keys #{:algorithm :after :limit}
+        opts-map (cond
+                   (empty? opts) nil
+                   (and (= 1 (count opts)) (map? (first opts))) (first opts)
+                   :else (apply hash-map opts))
+        bad-opts (set/difference (set (keys opts-map)) allowed-keys)]
+    (when (not-empty bad-opts)
+      (throw (IllegalArgumentException.
+               (str "Invalid options passed to list: "
+                    (str/join " " bad-opts)))))
+    (when-let [algorithm (:algorithm opts-map)]
+      (when-not (keyword? algorithm)
+        (throw (IllegalArgumentException.
+                 (str "Option :algorithm is not a keyword: "
+                      (pr-str algorithm))))))
+    (when-let [after (:after opts-map)]
+      (when-not (and (string? after) (re-matches #"^[0-9a-fA-F]*$" after))
+        (throw (IllegalArgumentException.
+                 (str "Option :after is not a hex string: "
+                      (pr-str after))))))
+    (when-let [limit (:limit opts-map)]
+      (when-not (and (integer? limit) (pos? limit))
+        (throw (IllegalArgumentException.
+                 (str "Option :limit is not a positive integer: "
+                      (pr-str limit))))))
+    (measure-method [::list opts-map]
+      (store/-list store opts-map))))

 (defn get
@@ -230,11 +241,13 @@
   (when-not (instance? Multihash id)
     (throw (IllegalArgumentException.
              (str "Id value must be a multihash, got: " (pr-str id)))))
-  (when-let [block (store/-get store id)]
-    (when-not (= id (:id block))
-      (throw (RuntimeException.
-               (str "Asked for block " id " but got " (:id block)))))
-    block))
+  (let [block (measure-method [::get id]
+                (store/-get store id))]
+    (when block
+      (when-not (= id (:id block))
+        (throw (RuntimeException.
+                 (str "Asked for block " id " but got " (:id block)))))
+      (meter/metered-block store ::meter/io-read block))))

 (defn put!
@@ -245,7 +258,13 @@
     (when-not (instance? Block block)
       (throw (IllegalArgumentException.
                (str "Argument must be a block, got: " (pr-str block)))))
-    (data/merge-blocks block (store/-put! store block))))
+    (data/merge-blocks
+      block
+      (measure-method [::put! block]
+        (->> block
+             (meter/metered-block store ::meter/io-write)
+             (store/-put! store)
+             (meter/metered-block store ::meter/io-read))))))

 (defn store!
@@ -269,7 +288,8 @@
   removed."
   [store id]
   (when id
-    (store/-delete! store id)))
+    (measure-method [::delete! id]
+      (store/-delete! store id))))

@@ -295,7 +315,9 @@
   [store ids]
   (validate-collection-of Multihash ids)
   (if (satisfies? store/BatchingStore store)
-    (remove nil? (store/-get-batch store ids))
+    (measure-method [::get-batch ids]
+      (keep (partial meter/metered-block store ::meter/io-read)
+            (store/-get-batch store ids)))
     (doall (keep (partial get store) ids))))

@@ -309,7 +331,11 @@
   (validate-collection-of Block blocks)
   (if-let [blocks (seq (remove nil? blocks))]
     (if (satisfies? store/BatchingStore store)
-      (store/-put-batch! store blocks)
+      (measure-method [::put-batch! blocks]
+        (->> blocks
+             (map (partial meter/metered-block store ::meter/io-write))
+             (store/-put-batch! store)
+             (map (partial meter/metered-block store ::meter/io-read))))
       (mapv (partial put! store) blocks))
     []))

@@ -324,7 +350,8 @@
   [store ids]
   (validate-collection-of Multihash ids)
   (if (satisfies? store/BatchingStore store)
-    (set (store/-delete-batch! store ids))
+    (measure-method [::delete-batch! ids]
+      (set (store/-delete-batch! store ids)))
     (set (filter (partial delete! store) ids))))

@@ -336,7 +363,8 @@
   store should be empty. This is not guaranteed to be an atomic operation!"
   [store]
   (if (satisfies? store/ErasableStore store)
-    (store/-erase! store)
+    (measure-method [::erase!! nil]
+      (store/-erase! store))
     (run! (comp (partial delete! store) :id)
           (store/-list store nil))))


Log Errors in addition to Exceptions.

Log Errors in addition to Exceptions.

--- src/cavm/loader.clj
+++ src/cavm/loader.clj
@@ -96,6 +96,9 @@
                                   (with-out-str
                                     (time (try
                                             (loader db detector docroot filename always)
-                                            (catch Exception e (log-error filename e))))))]
+                                            ; XXX Should re-throw Errors, but we need
+                                            ; to catch Throwable (instead of Exception)
+                                            ; in order to log it.
+                                            (catch Throwable e (log-error filename e))))))]
                           (info (str "Loaded " filename ", " t)))
                         nil)))))))


increment label nums

increment label nums

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -130,7 +130,7 @@
             :src      (:stream app)
             :autoPlay "autoplay"
             :style    (get-bg-transform app n)})
-          (dom/label nil n)))))
+          (dom/label nil (inc n))))))

 (defn grid [{:keys [grid-px] :as app}]


adding a near cache config

adding a near cache config

--- src/chazel/core.clj
+++ src/chazel/core.clj
@@ -11,7 +11,10 @@
            [com.hazelcast.client HazelcastClient]
            [com.hazelcast.client.impl HazelcastClientProxy]
            [com.hazelcast.client.config ClientConfig]
-           [com.hazelcast.config Config GroupConfig]
+           [com.hazelcast.config Config GroupConfig
+                                 InMemoryFormat
+                                 EvictionConfig EvictionPolicy EvictionConfig$MaxSizePolicy
+                                 NearCacheConfig NearCachePreloaderConfig NearCacheConfig$LocalUpdatePolicy]
            [com.hazelcast.map.listener EntryAddedListener
                                        EntryRemovedListener
                                        EntryEvictedListener
@@ -41,30 +44,90 @@
    (.setGroupConfig config (GroupConfig. group-name
                                          group-password))))

-(defn client-config [{:keys [hosts retry-ms retry-max group-name group-password]}]
+(defmacro call [m o v]
+  "calls (m o v) iff v is there"
+  `(when ~v
+     (~m ~o ~v)))
+
+(defmacro k->enum [value-of k]
+  "calls (enum/valueOf k) iff k is there"
+  `(when ~k
+     (~value-of (name ~k))))
+
+(defn eviction-config [{:keys [eviction-policy
+                               max-size-policy
+                               size]}]
+  (let [config (EvictionConfig.)
+        max-size-policy (k->enum EvictionConfig$MaxSizePolicy/valueOf
+                                 max-size-policy)
+        eviction-policy (k->enum EvictionPolicy/valueOf
+                                 eviction-policy)]
+    (call .setMaximumSizePolicy config max-size-policy)
+    (call .setEvictionPolicy config eviction-policy)
+    (call .setSize config size)
+    config))
+
+(defn preloader-config [{:keys [enabled
+                                directory
+                                store-initial-delay-seconds
+                                store-interval-seconds]}]
+  (let [config (NearCachePreloaderConfig.)]
+    (call .setEnabled config enabled)
+    (call .setDirectory config directory)
+    (call .setStoreInitialDelaySeconds config store-initial-delay-seconds)
+    (call .setStoreIntervalSeconds config store-interval-seconds)
+    config))
+
+(defn near-cache-config [{:keys [name
+                                 eviction
+                                 preloader
+                                 in-memory-format
+                                 invalidate-on-change
+                                 time-to-live-seconds
+                                 max-idle-seconds
+                                 cache-local-entries
+                                 local-update-policy]}]
+  (let [config (NearCacheConfig.)
+        eviction (when eviction (eviction-config eviction))
+        preloader (when preloader (preloader-config preloader))
+        local-update-policy (k->enum NearCacheConfig$LocalUpdatePolicy/valueOf
+                                     local-update-policy)
+        in-memory-format (k->enum InMemoryFormat/valueOf
+                                  in-memory-format)]
+    (call .setName config name)
+    (call .setEvictionConfig config eviction)
+    (call .setPreloaderConfig config preloader)
+    (call .setInMemoryFormat config in-memory-format)
+    (call .setInvalidateOnChange config invalidate-on-change)
+    (call .setTimeToLiveSeconds config time-to-live-seconds)
+    (call .setMaxIdleSeconds config max-idle-seconds)
+    (call .setLocalUpdatePolicy config local-update-policy)
+    (call .setCacheLocalEntries config cache-local-entries)
+    config))
+
+(defn client-config [{:keys [hosts retry-ms retry-max group-name group-password near-cache]
+                      :or {hosts ["127.0.0.1"]
+                           retry-ms 5000
+                           retry-max 720000
+                           group-name "dev"
+                           group-password "dev-pass"}}]
   (let [config (ClientConfig.)
-        groupConfig (GroupConfig. group-name group-password)]
+        groupConfig (GroupConfig. group-name group-password)
+        near-cache (when near-cache
+                     (near-cache-config near-cache))]
     (doto config
       (.getNetworkConfig)
       (.addAddress (into-array hosts))
       (.setConnectionAttemptPeriod retry-ms)
       (.setConnectionAttemptLimit retry-max))
-      (.setGroupConfig config groupConfig)
+    (.setGroupConfig config groupConfig)
+    (call .addNearCacheConfig config near-cache)  ;; only set near cache config if provided
     config))

 (defn instance-active? [instance]
   (-> instance
       (.getLifecycleService)
       (.isRunning)))
-
-(defonce
-  ;; "will only be used if no config is provided"
-  default-client-config
-  {:hosts ["127.0.0.1"]
-   :retry-ms 5000
-   :retry-max 720000
-   :group-name "dev"
-   :group-password "dev-pass"})                        ;; 720000 * 5000 = one hour

 (defonce c-instance (atom nil))

@@ -75,7 +138,7 @@
               group-password (assoc :group-password "********"))))

 (defn client-instance
-  ([] (client-instance default-client-config))
+  ([] (client-instance {}))
   ([conf]
     (let [ci @c-instance]
       (if (and ci (instance-active? ci))


Added reduce!

Added reduce!

as a shortcut for reducing over transient data structures.

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -381,6 +381,12 @@
 		  xs seen)))]
     (step sequence #{})))

+(defn reduce!
+  "Does the same as reduce, but calls transient on the initial value
+  and persistent! on the result."
+  [fn initial-value coll]
+  (persistent! (reduce fn (transient initial-value) coll)))
+
 (defn map-by-fn
   "Returns a hash map with the values of keys as keys and their values
   under function as values."


topological sort

topological sort

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -417,6 +417,16 @@
   (println (topological-sort module-dependencies))
   )

+(def global-init-shut-sequence
+  (let [init-sorted (topological-sort module-dependencies)
+        shut-sorted (reverse init-sorted)]
+    {:init-sequence (map #(get-in modules [% :init-sequence]) init-sorted)
+     :shut-sequence (map #(get-in modules [% :shut-sequence]) shut-sorted)}
+    ))
+
+(defn run-init-sequence
+  []
+  (map (fn [f] (f)) (:init-sequence global-init-shut-sequence)))

 ;; --------------------------------------------------------
 ;; Example 7: Generating some code based on data structure


Removed redundant code.

Removed redundant code.

--- src/cmr/opendap/rest/handler/collection.clj
+++ src/cmr/opendap/rest/handler/collection.clj
@@ -15,6 +15,16 @@
 ;;;   OUS Handlers   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(defn- generate
+  "Private function for creating OPeNDAP URLs when supplied with an HTTP
+  GET."
+  [request search-endpoint user-token concept-id data]
+  (log/debug "Generating URLs based on HTTP GET ...")
+  (->> data
+       (merge {:collection-id concept-id})
+       (ous/get-opendap-urls search-endpoint user-token)
+       (response/json request)))
+
 (defn- generate-via-get
   "Private function for creating OPeNDAP URLs when supplied with an HTTP
   GET."
@@ -22,9 +32,7 @@
   (log/debug "Generating URLs based on HTTP GET ...")
   (->> request
        :params
-       (merge {:collection-id concept-id})
-       (ous/get-opendap-urls search-endpoint user-token)
-       (response/json request)))
+       (generate request search-endpoint user-token concept-id)))

 (defn- generate-via-post
   "Private function for creating OPeNDAP URLs when supplied with an HTTP
@@ -34,9 +42,7 @@
        :body
        (slurp)
        (#(json/parse-string % true))
-       (merge {:collection-id concept-id})
-       (ous/get-opendap-urls search-endpoint user-token)
-       (response/json request)))
+       (generate request search-endpoint user-token concept-id)))

 (defn unsupported-method
   "XXX"
@@ -66,7 +72,7 @@
   (fn [request]
     {:error :not-implemented}))

-(defn stream
+(defn stream-urls
   ""
   [request]
   (log/debug "Processing stream request ...")
@@ -83,7 +89,8 @@
          (* id 200) ;; send a message every 200ms
          (log/debug "\tSending chunk to client ...")
          (server/send! channel
-                       (format "message #%s from server ..." id)
+                       ;(format "message #%s from server ..." id)
+                       {:status 202}
                        false))
         (recur (inc id))))
     (timer/schedule-task (* 10 200) (server/close channel))))


0.2.0-SNAPSHOT

--- clj-util/project.clj
+++ clj-util/project.clj
@@ -1,4 +1,4 @@
-(defproject oph/clj-util "0.1.0"
+(defproject oph/clj-util "0.2.0-SNAPSHOT"
   :description "oph clojure utilities"
   :url "http://example.com/FIXME"
   :license {:name "EUPL"


Fix a huge bug in the Clojure anagrams script

--- clojure/anagrams.clj
+++ clojure/anagrams.clj
@@ -3,13 +3,13 @@

 (defn generatePermutations [v n]
   (if (zero? n)
-    (println (apply str v))
+    (do (println (apply str v)) v)

     (loop [i 0 a v]
       (if (< i n)
         (do
-          (generatePermutations a (dec n))
-          (recur (inc i) (swap a (if (even? n) 0 i) n)))
+          (let [a (generatePermutations a (dec n))]
+          (recur (inc i) (swap a (if (even? n) 0 i) n))))
         (generatePermutations a (dec n))))))

 (if (not= (count *command-line-args*) 1)


fix mkdir args

fix mkdir args


start of export functionality

start of export functionality

--- src/latte/utils.clj
+++ src/latte/utils.clj
@@ -1,6 +1,7 @@
 (ns latte.utils
   "Misc. utilities for LaTTe libraries."
-  (:require [latte-kernel.norm :as norm]))
+  (:require [latte-kernel.defenv :as defenv]
+            [latte-kernel.norm :as norm]))

 ;; decomposer (rebindable) parameters
 (def ^:dynamic *decomposer-performs-delta-steps* true)
@@ -32,3 +33,33 @@
  should be used in this case."
   (alter-var-root defvar (fn [eq]
                            (update eq :opts (fn [opts] (assoc opts :opaque flag))))))
+
+
+(defn fetch-ns-elements
+  "Fetch the LaTTe elements in specified `ns` (or the current namespace by default)."
+  ([] (fetch-ns-elements *ns*))
+  ([ns] (let [defs (ns-map ns)
+              ;; some cleanups
+              defs (into {}
+                         (filter #(and (not (clojure.string/starts-with? (str (second %)) "#'clojure."))
+                                       (var? (second %))) defs))]
+          (reduce (fn [elems [ename evar]]
+                    (let [elem (var-get evar)]
+                      (cond
+                        (defenv/definition? elem)
+                        (assoc-in elems [:definitions ename] elem)
+                        (defenv/theorem? elem)
+                        (assoc-in elems [:theorems ename] elem)
+                        (defenv/axiom? elem)
+                        (assoc-in elems [:axioms ename] elem)
+                        (defenv/notation? elem)
+                        (assoc-in elems [:notations ename] elem)
+                        (defenv/implicit? elem)
+                        (assoc-in elems [:implicits ename] elem)
+                        :else elems)))
+                  {:theorems {}
+                   :definitions {}
+                   :axioms {}
+                   :notations {}
+                   :implicits {}} defs))))
+


Make the core namespace available in the repl


Makes name truly optional.

Makes name truly optional.

--- src/cadence/model/validators.clj
+++ src/cadence/model/validators.clj
@@ -15,20 +15,22 @@
   (rule (re-find #"^[a-zA-z][\-_\w]*( [\-_\w]+)*\w$" username)
         [:username (str "Username must match this regex "
                         "/^[a-zA-z][\\-_\\w]*( [\\-_\\w]+)*\\w$/")])
-  (rule (min-length? name 3)
-        [:name "Your name must be at least 3 characters long."])
-  (rule (max-length? name 64)
-        [:name "Your name must be no more than 64 characters long."])
-  (rule (re-find #"^[a-zA-z][\-'\w]*( [\-'\w]+)*\w$" name)
-        [:name (str "Your name must match this regex "
-                    "/^[a-zA-z][\\-'\\w]*( [\\-'\\w]+)*\\w$/")])
+  (when (has-value? name)
+    (do
+      (rule (min-length? name 3)
+            [:name "Your name must be at least 3 characters long."])
+      (rule (max-length? name 64)
+            [:name "Your name must be no more than 64 characters long."])
+      (rule (re-find #"^[a-zA-z][\-'\w]*( [\-'\w]+)*\w$" name)
+            [:name (str "Your name must match this regex "
+                        "/^[a-zA-z][\\-'\\w]*( [\\-'\\w]+)*\\w$/")])))
   (rule (min-length? password 8)
         [:password "Passwords must be at least 8 characters long."])
   (rule (max-length? password 64)
         [:password "Passwords must be no more than 64 characters long."])
   (rule (= password repeat-password)
         [:repeat-password "Your passwords did not match!"])
-  (rule (or (is-email? email) (empty? email))
+  (rule (or (is-email? email) (not (has-value? email)))
         [:email "Emails are optional, but the one you entered is invalid."])
   (rule (recaptcha/check recaptcha_challenge_field recaptcha_response_field)
         [:humans-only (if (empty? recaptcha_response_field)


From 826742d4f070fb64e056e914d2a5cbc05cd4b162 Mon Sep 17 00:00:00 2001 From: Thomas Jack <thomasjack@gmail.com> Date: Sat, 10 Dec 2011 11:53:27 -0600 Subject: [PATCH] ignore BigInt in Clojure 1.2

From 826742d4f070fb64e056e914d2a5cbc05cd4b162 Mon Sep 17 00:00:00 2001
From: Thomas Jack <a12d17f6833b0c246cdec3f5b04502e906d569cf@gmail.com>
Date: Sat, 10 Dec 2011 11:53:27 -0600
Subject: [PATCH] ignore BigInt in Clojure 1.2

--- src/clj/carbonite/serializer.clj
+++ src/clj/carbonite/serializer.clj
@@ -3,14 +3,15 @@
   (:import [com.esotericsoftware.kryo Kryo Serializer SerializationException]
            [com.esotericsoftware.kryo.serialize StringSerializer
             MapSerializer IntSerializer
-            LongSerializer BigDecimalSerializer BigIntegerSerializer DateSerializer]
+            LongSerializer BigDecimalSerializer BigIntegerSerializer
+            DateSerializer]
            [java.io ByteArrayInputStream InputStream]
            [java.nio ByteBuffer BufferOverflowException]
            [java.math BigDecimal BigInteger]
            [java.net URI]
            [java.util Date UUID]
            [java.sql Time Timestamp]
-           [clojure.lang BigInt Keyword Symbol PersistentArrayMap
+           [clojure.lang Keyword Symbol PersistentArrayMap
             PersistentHashMap MapEntry PersistentStructMap
             PersistentVector PersistentHashSet Ratio
             Cons PersistentList PersistentList$EmptyList Var
@@ -161,12 +162,15 @@
 (def ^{:doc "Define a map of Clojure primitives and their serializers
   to install."}
   clojure-primitives
-  (array-map
-   BigInt clojure-reader-serializer
-   Keyword clojure-reader-serializer
-   Symbol clojure-reader-serializer
-   Ratio clojure-reader-serializer
-   Var clojure-print-dup-serializer))
+  (let [prims (array-map
+               Keyword clojure-reader-serializer
+               Symbol clojure-reader-serializer
+               Ratio clojure-reader-serializer
+               Var clojure-print-dup-serializer)]
+    (if-let [big-int (try (Class/forName "clojure.lang.BigInt")
+                          (catch ClassNotFoundException _))]
+      (assoc prims big-int clojure-reader-serializer)
+      prims)))

 (def java-primitives
   (array-map