Fix an issue with double-spaced? for tactile books

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -290,6 +290,12 @@
        materials
        (remove nil?)
        (string/join ", ")))))
+
+(defn get-double-spaced
+  "Determine whether the item is double-spaced. Return true if the
+  `field` starts with \"Weitzeilig\", false otherwise."
+  [field]
+  (boolean (and field (re-find #"^Weitzeilig" field))))

 (defn- construct-producer-brief [producer-long producer-place]
   "Return a producer-brief string based on `producer-long` and
@@ -380,16 +386,13 @@
       :braille (let [rucksackbuch-number (and series-title
                                               (re-find #"^Rucksackbuch" series-title)
                                               (parse-int series-volume))
-                     double-spaced? (boolean
-                                     (and double-spaced?
-                                          (re-find #"^Weitzeilig" double-spaced?)))
                      braille-grade (braille-grade-raw-to-braille-grade braille-grade)]
                  (-> item
                      (assoc-some
                       :rucksackbuch-number rucksackbuch-number
                       :rucksackbuch? (boolean rucksackbuch-number)
                       :braille-grade braille-grade
-                      :double-spaced? double-spaced?
+                      :double-spaced? (get-double-spaced double-spaced?)
                       :volumes (parse-int volumes)
                       :accompanying-material (get-accompanying-material raw-item)
                       :print-and-braille? print-and-braille?)))
@@ -427,7 +430,7 @@
       :taktilesbuch (-> item
                         (assoc-some
                          :braille-grade (braille-grade-raw-to-braille-grade braille-grade)
-                         :double-spaced? double-spaced?
+                         :double-spaced? (get-double-spaced double-spaced?)
                          :accompanying-material (get-accompanying-material raw-item)
                          :print-and-braille? print-and-braille?))
       ; default case that shouldn't really happen. When the MARC21


Fix add-vent frontend

Fix add-vent frontend

--- tutorial.vent/src/tutorial/vent/frontend/main.cljs
+++ tutorial.vent/src/tutorial/vent/frontend/main.cljs
@@ -78,13 +78,13 @@
      [:form
       {:onSubmit (fn [e]
                    (.preventDefault e)
-                   (.reset (.-target e))
                    (-> (js/fetch "/vent"
                                  #js {:method "PUT"
                                       :body (new js/FormData (.-target e))})
                        (.then
                          (fn [_]
-                           (fetch-global-page)))))}
+                           (fetch-global-page))))
+                   (.reset (.-target e)))}
       [:textarea.compose__input
        {:name "text"
         :onKeyDown


CMR-1280: Fixes conversion from iso to echo10 and back

--- umm-lib/test/cmr/umm/test/iso_mends/collection.clj
+++ umm-lib/test/cmr/umm/test/iso_mends/collection.clj
@@ -15,7 +15,9 @@
             [cmr.umm.echo10.core :as echo10]
             [cmr.umm.collection :as umm-c]
             [cmr.umm.iso-mends.core :as iso]
-            [cmr.umm.test.echo10.collection :as test-echo10]))
+            [cmr.umm.spatial :as umm-s]
+            [cmr.umm.test.echo10.collection :as test-echo10]
+            [cmr.spatial.derived :as d]))

 (defn- spatial-coverage->expected-parsed
   [{:keys [geometries spatial-representation] :as sc}]
@@ -122,6 +124,15 @@
         (assoc :personnel personnel)
         umm-c/map->UmmCollection)))

+(defn derive-geometries
+  [{:keys [spatial-representation] :as sc}]
+  (when sc
+    (update-in sc [:geometries] (fn [geoms]
+                                  (map #(d/calculate-derived
+                                         (umm-s/set-coordinate-system spatial-representation
+                                                                      %))
+                                       geoms)))))
+
 (defspec generate-collection-is-valid-xml-test 100
   (for-all [collection coll-gen/collections]
     (let [xml (iso/umm->iso-mends-xml collection)]
@@ -140,6 +151,7 @@
   (for-all [collection coll-gen/collections]
     (let [xml (iso/umm->iso-mends-xml collection)
           parsed-iso (c/parse-collection xml)
+          parsed-iso (update-in parsed-iso [:spatial-coverage] derive-geometries)
           echo10-xml (echo10/umm->echo10-xml parsed-iso)
           parsed-echo10 (echo10-c/parse-collection echo10-xml)
           expected-parsed (test-echo10/umm->expected-parsed-echo10 (umm->expected-parsed-iso collection))]


Lower timeout on DOI fetch

Lower timeout on DOI fetch

--- src/chronograph/mdapi.clj
+++ src/chronograph/mdapi.clj
@@ -112,7 +112,7 @@
                   (fn [doi]
                     (let [url (str "http://dx.doi.org/" doi)
                           result (try (try-try-again {:sleep 1000 :tries 2}
-                                       #(client/get url))
+                                       #(client/get url  {:socket-timeout 5000  :conn-timeout 5000 :throw-exceptions true}))
                                    (catch Exception _ nil))
                           ; drop first, it's always "dx.doi.org"
                           redirects (rest (:trace-redirects result))


special case cljs.core source map caching for now

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -218,7 +218,10 @@
                (:ns (ana/parse-ns (js-src->cljs-src f))))]
       (as-> @env/*compiler* compiler-env
         (let [t (util/last-modified smf)]
-          (if (> t (get-in compiler-env [::source-maps ns :last-modified] 0))
+          (if (or (and (= ns 'cljs.core)
+                       (nil? (get-in compiler-env [::source-maps ns])))
+                  (and (not= ns 'cljs.core)
+                       (> t (get-in compiler-env [::source-maps ns :last-modified] 0))))
             (swap! env/*compiler* assoc-in [::source-maps ns]
               {:last-modified t
                :source-map (sm/decode (json/read-str (slurp smf) :key-fn keyword))})


apply added-virus-counter if virus enters play with a counter

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1497,6 +1497,9 @@
                    (system-msg state side (str (build-spend-msg cost-str "install") title
                                             (when host-card (str " on " (:title host-card)))
                                             (when no-cost " at no cost")))))
+                 (if (and (= (:counter-type installed-card) "Virus") (> (:counter installed-card) 0))
+                   (update! state side (assoc installed-card :added-virus-counter true))
+                   )
                  (trigger-event state side :runner-install installed-card)
                  (when (has? c :subtype "Icebreaker") (update-breaker-strength state side c))))))
          (when (has? card :type "Resource") (swap! state assoc-in [:runner :register :installed-resource] true))


add tracking code

add tracking code

--- src/clj/hsm/views.clj
+++ src/clj/hsm/views.clj
@@ -4,6 +4,7 @@
     [hiccup.core        :refer [html]]
     [hiccup.page        :refer [doctype include-css include-js]]
     [hiccup.def         :refer [defhtml]]
+    [hsm.dev            :refer [is-dev?]]
     [hsm.conf           :refer [languages]]))

 (defhtml row-fluid
@@ -36,15 +37,22 @@
     [:tr [:td
     [:a {:href (format "/%s/top-projects" lang)} lang]]])])

+(def propert-ids
+  { "hackersome.com" "UA-57973731-1"
+    "sweet.io" "UA-33058338-1"
+    "pythonhackers.com" "UA-42128994-1"
+    "clojurehackers.com" "UA-57973731-3"
+    "dev.hackersome.com" "UA-57973731-1" })
+
 (defhtml layout
   [website & content]
+  (let [property-id (get propert-ids website)]
   (:html5 doctype)
   [:html {:lang "en-US"}
    [:head
     [:meta {:charset "UTF-8"}]
     [:meta {:content "IE=edge,chrome=1"
             :http-equiv "X-UA-Compatible"}]
-    [:meta {:name "google-site-verification" :content "TbfTN22-TdrZU60a5X6UGJCHQXMYJN2dvVb5Ibn0C6E"}]
     [:title "Hackersome"]
     (include-css "//maxcdn.bootstrapcdn.com/bootswatch/3.3.1/flatly/bootstrap.min.css")
     (include-css "//maxcdn.bootstrapcdn.com/font-awesome/4.2.0/css/font-awesome.min.css")
@@ -72,5 +80,14 @@
       [:div.col-lg-1]
      ]
     (include-js "//ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js")
-    (include-js "//maxcdn.bootstrapcdn.com/bootstrap/3.3.1/js/bootstrap.min.js")
-    ]])+    (include-js "//maxcdn.bootstrapcdn.com/bootstrap/3.3.1/js/bootstrap.min.js")
+    (when (if (nil? is-dev?) true is-dev?)
+      [:script {:type "text/javascript"}
+      (format "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+  ga('create', '%s', 'auto');
+  ga('send', 'pageview');" property-id)]
+      )
+    ]]))


Better confirmation page

Better confirmation page

--- src/app/core.cljs
+++ src/app/core.cljs
@@ -330,8 +330,19 @@
   (om/component
    (html
     [:main
-     [:h1 "Confirmed!"]
-     [:pre (with-out-str (pp/pprint @response))]])))
+     [:h1 "Thank you!"]
+     (let [{:keys [guests] :as selection} (om/observe owner (selection))]
+       [:pre (with-out-str (pp/pprint @selection))]
+       [:ul
+        (map (fn [{:keys [id name] :as guest}]
+               [:li (str name
+                         (if (get-in response [:infos id]) " will " " will not ")
+                         "attend.")])
+             guests)])
+     [:h2 "Doesn't look right?"]
+     [:p "Please " [:a {:href "mailto:anhthuandzane@googlegroups.com"}
+                    "email us"]
+      " and let us know!"]])))

 (defn rsvp-search-results-view [{:keys [name results] :as data} owner]
   (reify


Split (list-all-files) out of (list-files)

(list-unignored-files) has been renamed to (list-files)

--- src/clj_git/index.clj
+++ src/clj_git/index.clj
@@ -240,18 +240,22 @@
 (defn is-file-staged [filename]
   (contains? (into #{} (list-staged-files)) filename))

-(defn list-unignored-files []
-  (let [root-filter-str "/.git/"
-        gitignore-patterns  (-> (slurp ".gitignore") (clojure.string/split #"\n"))
-        buildin-patterns    [root-filter-str ".gitignore"]
+(defn list-all-files []
+  (->>
+    (clojure.java.io/file ".")
+    (file-seq)
+    (filter #(not (.isDirectory %)))
+    (map #(.getPath %))
+    (filter #(not (glob-match? "/.git/" %)))
+))
+
+(defn list-files []
+  (let [gitignore-patterns  (-> (slurp ".gitignore") (clojure.string/split #"\n"))
+        buildin-patterns    [".gitignore"]
         patterns            (concat buildin-patterns gitignore-patterns)
         f                   (fn [g ss] (filter #(not (glob-match? g %)) ss))
         filters             (map #(partial f %) patterns)]
-    (->>
-      (clojure.java.io/file ".")
-      (file-seq)
-      (filter #(not (.isDirectory %)))
-      (map #(.getPath %))
+    (->> (list-all-files)
       ((apply comp filters))
       (map #(.substring % 2))
   )
@@ -261,5 +265,5 @@
   (let [index       (read-index)
         index-names (map #(:name %) index)
         index-set   (into #{} index-names)
-        wd-set      (into #{} (list-unignored-files))]
+        wd-set      (into #{} (list-files))]
     (vec (clojure.set/difference wd-set index-set))))


Checkpoint

Checkpoint

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/cljparse/core.clj
+++ src/cljparse/core.clj
@@ -33,4 +33,4 @@
                             :else
                             (do
                               (println "Starting cljparse on:" (.getAbsolutePath file))
-                              (config/parser file))))))))
+                              (println (config/parser file)))))))))


htmlfix

htmlfix

--- src/tango/generate_recalled.clj
+++ src/tango/generate_recalled.clj
@@ -27,9 +27,10 @@
     temp-result))

 (defn generate-html [recalled-info]
-  (h/html [:head
-           [:title "Last Recalled"]
-           [:style {:type "text/css"} "#stor { Font-size: 54px; } #liten { Font-size: 36px; }"]]
+  (h/html [:html
+           [:head
+                  [:title "Last Recalled"]
+                  [:style {:type "text/css"} "#stor { Font-size: 54px; } #liten { Font-size: 36px; }"]]]

           [:body
            [:h1 [:font {:id "stor"} (str "Event " (:activity/number recalled-info))]]


Move info about shorthand functions, drop vecabs

--- src/uk/co/tombooth/pollock.cljs
+++ src/uk/co/tombooth/pollock.cljs
@@ -291,22 +291,6 @@
     (+ (* mass y-gravity) (/ (* mass y-velocity y-velocity)
                              (* 2 impact-distance)))))

-;; In order to work out this value as a scalar we will need to be able
-;; to calculate the absolute value of a vector. This can be done by
-;; summing the squares of the vector's components and then taking the
-;; square root of that summation.
-
-;; This function will introduce a shorthand for defining functions
-;; that is very useful in combination with functions like `map` and
-;; `reduce`. Rather than writing `(fn [args...] body)` you can use
-;; `#(body)` and if you want access to the arguments use `%n` where
-;; `n` is the position of the argument. If you are only expecting one
-;; argument then you can use just `%` on its own.
-
-(defn vector-absolute [vector]
-  (Math/sqrt (reduce + (map #(* % %) vector))))
-
-
 ;; Based of this function to calculate the impact force we can define
 ;; a predicate that will tell us whether paint should splatter based
 ;; off its mass and velocity. It is idiomatic in Clojure to end
@@ -345,6 +329,13 @@

 (defn vector-subtraction [vector1 vector2]
   (map - vector1 vector2))
+
+;; This function will introduce a shorthand for defining functions
+;; that is very useful in combination with functions like `map` and
+;; `reduce`. Rather than writing `(fn [args...] body)` you can use
+;; `#(body)` and if you want access to the arguments use `%n` where
+;; `n` is the position of the argument. If you are only expecting one
+;; argument then you can use just `%` on its own.

 (defn vector-multiply-by-constant [vector constant]
   (map #(* % constant) vector))


Generalized the dot form classification

Generalized the dot form classification

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -122,10 +122,10 @@
     {:name (js-var sym)}
     (let [s (str sym)
           lb (-> env :locals sym)
-          nm
+          nm
           (cond
            lb (:name lb)
-
+
            (namespace sym)
            (let [ns (namespace sym)
                  ns (if (= "clojure.core" ns) "cljs.core" ns)]
@@ -463,7 +463,7 @@
           (print (str "catch (" name "){"))
           (when catch
             (let [{:keys [statements ret]} catch]
-              (emit-block subcontext statements ret)))
+              (emit-block subcontext statements ret)))
           (print "}"))
         (when finally
           (let [{:keys [statements ret]} finally]
@@ -603,7 +603,7 @@

 (defmethod parse 'if
   [op env [_ test then else :as form] name]
-  (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
+  (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
         then-expr (analyze env then)
         else-expr (analyze env else)]
     {:env env :op :if :form form
@@ -685,7 +685,7 @@
         recur-frame {:names (vec (map munge params)) :flag (atom nil)}
         block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
                 (analyze-block (assoc env :context :return :locals locals) body))]
-
+
     (merge {:env env :variadic variadic :params (map munge params) :max-fixed-arity fixed-arity :gthis gthis :recurs @(:flag recur-frame)} block)))

 (defmethod parse 'fn*
@@ -865,7 +865,6 @@

 (defmulti build-dot-form #(classify-dot-form %))

-
 ;; (. o -p)
 ;; (. (...) -p)
 (defmethod build-dot-form [::expr ::property ()]
@@ -1144,7 +1143,7 @@
    Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
    If the file was not compiled returns only {:file ...}"
   ([src]
-     (let [dest (rename-to-js src)]
+     (let [dest (rename-to-js src)]
        (compile-file src dest)))
   ([src dest]
      (let [src-file (io/file src)
@@ -1270,7 +1269,7 @@
 (deftype Foo [a] IMeta (-meta [_] (fn [] a)))
 ((-meta (Foo. 42)))

-;;OLD way, don't you want to use the REPL?
+;;OLD way, don't you want to use the REPL?
 (in-ns 'cljs.compiler)
 (import '[javax.script ScriptEngineManager])
 (def jse (-> (ScriptEngineManager.) (.getEngineByName "JavaScript")))


defs without init should not bind var value to undefined, reuse previous value. This is so that declare preserve the same semantics as it does in Clojure.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -353,7 +353,7 @@
     (emits mname)
     (if init
       (emits " = " init)
-      (emits " = undefined"))
+      (emits " = (typeof " mname " != 'undefined') ? " mname " : undefined"))
     (when-not (= :expr (:context env)) (emitln ";"))
     (when export
       (emitln "goog.exportSymbol('" (munge export) "', " mname ");"))))


Preparing for activating my user.

Preparing for activating my user.

--- src/clj/movement/util.clj
+++ src/clj/movement/util.clj
@@ -66,6 +66,12 @@
                        :user/name "movementsession"
                        :user/valid-subscription? true}]]
     (d/transact conn tx-user-data))
+
+#_(let [tx-user-data [{:db/id                    #db/id[:db.part/user]
+                     :user/email               "andflak@gmail.com"
+                       :user/name "andreasflakstad"
+                     :user/valid-subscription? true}]]
+  (d/transact conn tx-user-data))

 ;; Get the database value.
 #_(def db (d/db conn))


allow cljs compilation with missing env vars

--- src/clj/tictag/config.clj
+++ src/clj/tictag/config.clj
@@ -11,7 +11,7 @@
                    :host     (env :pg-host "127.0.0.1")
                    :user     (env :pg-user)
                    :password (env :pg-password)}
-   :crypto-key    (codecs/hex->bytes (:tictag-crypto-key env))
+   :crypto-key    (codecs/hex->bytes (or (:tictag-crypto-key env) "deadbeef"))
    :slack         {:verification-token (env :slack-verification-token)}
    :tagtime       {:seed (or (some-> env :tagtime-seed Integer.) 666)
                    :gap  (or (some-> env :tagtime-gap Integer.) (* 60 45))}


Fix menu rendering.

Fix menu rendering.

--- src/cljs/beatha/core.cljs
+++ src/cljs/beatha/core.cljs
@@ -518,5 +518,3 @@

 (render-menu-view)
-(render-cellular-automaton (gen-app-view
-                   a/market-model market-model-customization))


Fix for Safri

Fix for Safri

Using merge-with on two CientRects in Safari gives,
"Error: No protocol method ISeqable.-seq defined for type object: [object
ClientRect]"

Do this manually for now

--- src/cljs/ji/ui/board.cljs
+++ src/cljs/ji/ui/board.cljs
@@ -21,8 +21,14 @@
 (defn separate [f coll] [(filter f coll) (filter (complement f) coll)])

 (defn bounding-client-rect-diff
+  "Implementation detail: merge-with fails on Safari"
   [a b]
-  (merge-with - (dom/bounding-client-rect a) (dom/bounding-client-rect b)))
+  {:left (- (:left a) (:left b))
+   :right (- (:right a) (:right b))
+   :top (- (:top a) (:top b))
+   :bottom (- (:bottom a) (:bottom b))
+   :width (- (:width a) (:width b))
+   :height (- (:height a) (:height b))})

 ;;


small bugfix

small bugfix

--- src/cljs/josefk/core.cljs
+++ src/cljs/josefk/core.cljs
@@ -531,8 +531,8 @@
   (q/fill (:color state) 255 255)
   ; Calculate x and y coordinates of the circle.
   ;(let [angle (:angle state)
-   ;     x (* 150 (q/cos angle))
-    ;    y (* 150 (q/sin angle))]
+  ;     x (* 150 (q/cos angle))
+  ;    y (* 150 (q/sin angle))]
   (let [x 19
         y 16
         meta-bounding-box (q/rect (* 0.25 x-scalar)
@@ -614,50 +614,47 @@
                               (* 3 y-scalar))
         code (get-in @app-state [:opcode])

-
-
-
         ]
     (apply q/fill [200])
     (q/rect (* 19 x-scalar)
-                               (* 16 y-scalar)
-                               (* 7 x-scalar)
-                               (* 5 y-scalar))
+            (* 16 y-scalar)
+            (* 7 x-scalar)
+            (* 5 y-scalar))
     (q/rect (* 28 x-scalar)
-                                (* 16 y-scalar)
-                                (* 7 x-scalar)
-                                (* 5 y-scalar))
+            (* 16 y-scalar)
+            (* 7 x-scalar)
+            (* 5 y-scalar))
     (q/rect (* 19 x-scalar)
-                             (* 5 y-scalar)
-                             (* 16 x-scalar)
-                             (* 9.5 y-scalar))
+            (* 5 y-scalar)
+            (* 16 x-scalar)
+            (* 9.5 y-scalar))
     (q/rect (* 20 x-scalar)
-                            (* 9 y-scalar)
-                            (* 14 x-scalar)
-                            (* 5 y-scalar))
+            (* 9 y-scalar)
+            (* 14 x-scalar)
+            (* 5 y-scalar))
     (q/rect (* 1 x-scalar)
-                             (* 5 y-scalar)
-                             (* 16 x-scalar)
-                             (* 9.5 y-scalar))
+            (* 5 y-scalar)
+            (* 16 x-scalar)
+            (* 9.5 y-scalar))
     (q/rect (* 20 x-scalar)
-                   (* 6.5 y-scalar)
-                   (* 14 x-scalar)
-                   (* 1.75 y-scalar))
+            (* 6.5 y-scalar)
+            (* 14 x-scalar)
+            (* 1.75 y-scalar))
     (q/rect (* 10 x-scalar)
-                                (* 8.33 y-scalar)
-                                (* 4 x-scalar)
-                                (* 2.41 y-scalar))
+            (* 8.33 y-scalar)
+            (* 4 x-scalar)
+            (* 2.41 y-scalar))
     (q/rect (* 2 x-scalar)
-                                (* 6.5 y-scalar)
-                                (* 6 x-scalar)
-                                (* 7 y-scalar))
+            (* 6.5 y-scalar)
+            (* 6 x-scalar)
+            (* 7 y-scalar))
     ;Move origin point to the center of the sketch.
     ; Draw the circle.
     (apply q/fill [63 2 0])
-    (q/line  (* 12 x-scalar) op-sentinel-y op-sentinel-x op-sentinel-y)
-    (q/line  (* 12 x-scalar) op-sentinel-y (* 12 x-scalar) (* 8.33 y-scalar))
-    (q/line  (* 12 x-scalar) targ-y targ-x targ-y)
-    (q/line  (* 12 x-scalar) targ-y (* 12 x-scalar) (* 10.75 y-scalar))
+    (q/line (* 12 x-scalar) op-sentinel-y op-sentinel-x op-sentinel-y)
+    (q/line (* 12 x-scalar) op-sentinel-y (* 12 x-scalar) (* 8.33 y-scalar))
+    (q/line (* 12 x-scalar) targ-y targ-x targ-y)
+    (q/line (* 12 x-scalar) targ-y (* 12 x-scalar) (* 10.75 y-scalar))

@@ -698,8 +695,8 @@
     (q/ellipse targ-x targ-y (* 2 x-scalar) (* 2 y-scalar))

     ;
-   ;   (q/line op-sentinel-x op-sentinel-y (* 21.5 x-scalar) (* 7.33 y-scalar))
-   ;   (q/line op-sentinel-x op-sentinel-y (* 15 x-scalar) (* 11.75 y-scalar)))
+    ;   (q/line op-sentinel-x op-sentinel-y (* 21.5 x-scalar) (* 7.33 y-scalar))
+    ;   (q/line op-sentinel-x op-sentinel-y (* 15 x-scalar) (* 11.75 y-scalar)))

     ;solder the sentinels to the opcode getter
@@ -750,12 +747,12 @@
                        (q/text (str "(put :r2 (target))") (get (line 3) :x) (get (line 3) :y))
                        (q/text (str "(put " (get-in @keyboard-input [:key-id]) " :r2)") (get (line 4) :x) (get (line 4) :y))
                        (q/text (str "=> 'ok") (get (line 2) :x) (get (line 2) :y))
-          (= code 3) (do
-                       (q/text (str "loading instr reg 3...") (get (line 1) :x) (get (line 1) :y))
-                       (q/text (str "...") (get (line 2) :x) (get (line 2) :y))
-                       (q/text (str "(eval '(put (key) (target))") (get (line 3) :x) (get (line 3) :y))
-                       (q/text (str "=> (put " (get-in @keyboard-input [:key-id]) " " (translate-target) ")") (get (line 4) :x) (get (line 4) :y))))))
-
+                       (= code 3) (do
+                                    (q/text (str "loading instr reg 3...") (get (line 1) :x) (get (line 1) :y))
+                                    (q/text (str "...") (get (line 2) :x) (get (line 2) :y))
+                                    (q/text (str "(eval '(put (key) (target))") (get (line 3) :x) (get (line 3) :y))
+                                    (q/text (str "=> (put " (get-in @keyboard-input [:key-id]) " " (translate-target) ")") (get (line 4) :x) (get (line 4) :y))))))
+  )
                      ;;1 push to empty y register
                      ;(fn [e] (do (divert-route :current-target :y)
                      ;            (put e :current-target)))


[n.init] Support nREPL middleware passed to project's :repl-options

--- src/clojure/neko/init.clj
+++ src/clojure/neko/init.clj
@@ -46,14 +46,20 @@
   nREPL expects it to be there while initializing. References nrepl's
   `start-server` function on demand because the project can be
   compiled without nrepl dependency."
-  [& repl-args]
+  [middleware & repl-args]
   (binding [*ns* (create-ns 'user)]
     (refer-clojure)
     (use 'clojure.tools.nrepl.server)
     (require '[clojure.tools.nrepl.middleware.interruptible-eval :as ie])
     (with-redefs-fn {(resolve 'ie/configure-thread-factory)
                      android-thread-factory}
-      #(apply (resolve 'start-server) repl-args))))
+      #(apply (resolve 'start-server)
+              :handler (apply (resolve 'default-handler)
+                              (map (fn [sym]
+                                     (require (symbol (namespace sym)))
+                                     (resolve sym))
+                                   middleware))
+              repl-args))))

 (defmacro
   ^{:private true
@@ -62,9 +68,10 @@
   [port other-args]
   (when (or (not (::release-build *compiler-options*))
             (::start-nrepl-sever *compiler-options*))
-    (let [build-port (::nrepl-port *compiler-options*)]
+    (let [build-port (::nrepl-port *compiler-options*)
+          mware (list `quote (::nrepl-middleware *compiler-options*))]
       `(let [port# (or ~port ~build-port 9999)]
-         (apply start-repl :port port# ~other-args)
+         (apply start-repl ~mware :port port# ~other-args)
          (neko.log/i "Nrepl started at port" port#)))))

 (defn enable-compliment-sources


add route53_record helper

add route53_record helper

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -125,6 +125,22 @@

 (def security-group
   (partial scoped-security-group identity))
+
+(defn safe-name [s]
+  (string/replace s #"\." "__"))
+
+(def dns-zone "mastodonc.net")
+(def dns-zone-id "Z1EFD0WXZUIXYT")
+
+(defn route53_record [prefix spec]
+  (let [name (str prefix "." dns-zone)]
+    (resource "aws_route53_record" (safe-name name)
+              (merge
+               {:zone_id dns-zone-id
+                :name name
+                :type "A"
+                :ttl  "300"}
+               spec))))

 (defn aws-instance [name spec]
   (let [default-sg-ids (map (partial id-of "aws_security_group") default-sgs)]


story and book names full-text searchable

--- src/clj/iwaswhere_web/fulltext_search.clj
+++ src/clj/iwaswhere_web/fulltext_search.clj
@@ -14,7 +14,7 @@
 (defn add-to-index
   "Adds entry to Lucene index. Removes older version of the same entry first."
   [{:keys [msg-payload]}]
-  (let [entry (select-keys msg-payload [:timestamp :md])]
+  (let [entry (select-keys msg-payload [:timestamp :md :story-name :book-name])]
     (remove-from-index {:msg-payload entry})
     (clucy/add index entry)))


sort go terms in heatmap alphabetically

sort go terms in heatmap alphabetically

--- src/cljs/gointermod/heatmap/handlers.cljs
+++ src/cljs/gointermod/heatmap/handlers.cljs
@@ -24,13 +24,11 @@

 (defn merge-results [results go-branch]
   "merges results from all organisms into one big fat map, and filters out the other two go branches"
-  (filter
-    (fn [result]
+  (sort-by :go-term      ;;sort by GO term
+    (filter (fn [result] ;;only return branches we care about
       (= (:ontology-branch result) go-branch))
-     (apply concat (map (fn [[_ organism]]
-       organism
-   ) results)))
-  )
+    (apply concat (map (fn [[_ organism]] ;;merge it all
+organism) results)))))

 (defn extract-go-terms [results]
   "just an ordered array of terms, thanks"
@@ -83,7 +81,7 @@
         organisms-present (keys counts)
         missing-organisms (find-missing-organisms counts)]
     ;  (.clear js/console)
-    ;  (.log js/console (clj->js merged-results))
+      (.log js/console (clj->js merged-results))
     {:rows final-heatmap-matrix :headers go-terms :max-count max-count :missing-organisms missing-organisms }
     ))


Fix merge-logs havoc-causing bug

Fix merge-logs havoc-causing bug

I forgot to cast the results of concat back to a vector. So it failed
the next time I tried to append a fresh log entry.

--- src/clojure/frereth_cp/shared/logging.clj
+++ src/clojure/frereth_cp/shared/logging.clj
@@ -357,10 +357,10 @@
   ;; consider the dangers of losing entries to things like
   ;; exceptions
   (let [result (concat xs ys)]
-    (sort (fn [x y]
-            (compare [(::lamport x) (::time x) (log-level-values (::level x)) (::message x)]
-                     [(::lamport y) (::time y) (log-level-values (::level y)) (::message y)]))
-          result)))
+    (vec (sort (fn [x y]
+                 (compare [(::lamport x) (::time x) (log-level-values (::level x)) (::message x)]
+                          [(::lamport y) (::time y) (log-level-values (::level y)) (::message y)]))
+               result))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


little faster?

little faster?

--- src/com/billpiel/sayid/string_output2.clj
+++ src/com/billpiel/sayid/string_output2.clj
@@ -328,29 +328,31 @@
                                          :end end-pos)
                                   (conj agg $)))))))

+;; 102
 (defn remove-nil-vals
   [m]
-  (->> m
-       (remove #(-> % second nil?))
-       (into {})))
+  (apply merge (for [[k v] m :when (not (nil? v))] {k v})))

 (defn tkn->simple-type
   [t]
   (-> t :type first))

+(def ^:const  type->color {:int :cyan
+                           :float :cyan
+                           :string :magenta
+                           :keyword :yellow
+                           :symbol :cyan
+                           :truncator :black})
+
+(def ^:const  type->bg-color {:truncator :white})
+
 (defn apply-type-colors-to-token
   [token]
-  (let [type->color {:int :cyan
-                     :float :cyan
-                     :string :magenta
-                     :keyword :yellow
-                     :symbol :cyan
-                     :truncator :black}
-        type->bg-color {:truncator :white}]
+  (let [st (tkn->simple-type token)]
     (merge token
-           (when-let [color (type->color (tkn->simple-type token))]
+           (when-let [color (type->color st)]
              {:fg-color color})
-           (when-let [color (type->bg-color (tkn->simple-type token))]
+           (when-let [color (type->bg-color st)]
              {:bg-color color}))))

 (defn mk-text-props
@@ -605,22 +607,3 @@
        flatten
        (remove nil?)
        split-text-tag-coll))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


update tests for new validation

update tests for new validation

--- test/gangway/web_test.clj
+++ test/gangway/web_test.clj
@@ -11,55 +11,49 @@

 (def token (:token (gw-auth/add-queue-token! "Testing" 3 (:db-conn galleon/system))))

+(def uri (format "%s/gangway/in/showevidence/showevidence/task/392" (immutant.util/app-uri)))
+
 (def invalid-message
   (json/json-str
-   {:header {:operation :assert
-             :entity-id {:task-id 137}
-             :entity-type :task}
-    :payload {:entity {:id-sk-origin "vlacs"
-                       :name "Master the art of addition"
-                       :description "This is some sort of description"}}}))
+   {:name "blarp"
+    :version "v3"}))

 (def valid-message
   (json/json-str
-   {:header {:operation :assert
-             :entity-id {:task-id 17}
-             :entity-type :task}
-    :payload {:entity {:id-sk-origin "vlacs"
-                       :name "Master the art of addition"
-                       :version "v3"
-                       :description "This is some sort of description"}}}))
+   {:name "blarp"
+    :version "v3"
+    :description "description"}))

-#_(deftest remote-http-test-malformed
+(deftest remote-http-test-malformed
   (let [result (http/post
-                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
+                uri
                 {:headers {"Authorization" (format "Token %s" token)}
                  :body invalid-message
                  :throw-exceptions false})]
     (testing "malformed request (missing a required field)"
       (is (= 400 (:status result))))))

-#_(deftest remote-http-test-success
+(deftest remote-http-test-success
   (let [result (http/post
-                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
+                uri
                 {:headers {"Authorization" (format "Token %s" token)}
                  :body valid-message
                  :throw-exceptions false})]
     (testing "successful request"
       (is (= 201 (:status result))))))

-#_(deftest remote-http-test-authentication-incorrect-token
+(deftest remote-http-test-authentication-incorrect-token
   (let [result (http/post
-                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
+                uri
                 {:headers {"Authorization" "Token thisisnotavalidtoken"}
                  :body valid-message
                  :throw-exceptions false})]
     (testing "incorrect authentication token"
       (is (= 401 (:status result))))))

-#_(deftest remote-http-test-authentication-no-header
+(deftest remote-http-test-authentication-no-header
   (let [result (http/post
-                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
+                uri
                 {:body valid-message
                  :throw-exceptions false})]
     (testing "authentication token missing from header"


sometimes, imagemagick returns non zero but the resulting thumbnail is fine :(

--- src/vignette/util/thumbnail.clj
+++ src/vignette/util/thumbnail.clj
@@ -54,7 +54,9 @@
         args (reduce conj base-command thumb-options)
         sh-out (run-thumbnailer args)]
     (cond
-      (zero? (:exit sh-out)) (io/file temp-file)
+      (or (zero? (:exit sh-out))
+          (and (= 1 (:exit sh-out))
+               (file-exists? temp-file))) (io/file temp-file)
       :else (throw+ {:type :convert-error
                      :error-code (:exit sh-out)
                      :error-string (:err sh-out)}


Added test for type hints

Added test for type hints

--- test/hiccup/core_test.clj
+++ test/hiccup/core_test.clj
@@ -106,7 +106,7 @@
   (is (= (let [x "foo"] (html [:span x]))
          "foo")))

-(deftest optimized-forms-work-correctly
+(deftest optimized-forms
   (is (= (html [:ul (for [n (range 3)]
                       [:li n])])
          "

0

1

2

"))
@@ -114,3 +114,8 @@
                        [:span "foo"]
                        [:span "bar"])])
          "
foo
")))
+
+(deftest type-hints
+  (let [string "x", number 1]
+    (is (= (html [:span #^String string]) "x"))
+    (is (= (html [:span #^Integer number]) "1"))))


load games when logged in, hide content otherwise

--- src/cljs/wombats_web_client/panels/available-games.cljs
+++ src/cljs/wombats_web_client/panels/available-games.cljs
@@ -19,10 +19,19 @@
                             :value "JOIN"
                             :onClick #(join-open-game game-id (:id (first @wombats)) "white")}]]))

+(defn panel []
+  (let [open-games (re-frame/subscribe [:open-games])]
+    [:div.open-games-panel
+     [:div (str "This is the Open Games page.")]
+     [temp-poll-button]
+     [:ul.open-games-list (map temp-game-card @open-games)]]))
+
+(defn login-prompt []
+  [:div (str "You must login to see open games.")])
+
 (defn open-games []
-  (let [open-games (re-frame/subscribe [:open-games])]
+  (let [current-user (re-frame/subscribe [:current-user])]
     (fn []
-      [:div.open-games-panel
-       [:div (str "This is the Open Games page.")]
-       [temp-poll-button]
-       [:ul.open-games-list (map temp-game-card @open-games)]])))
+      (if (nil? @current-user)
+        [login-prompt]
+        [panel]))))


Add debug-dom which returns a representation of the DOM that can be pretty printed for debugging purposes.

--- src/main/clojure/cascade/dom.clj
+++ src/main/clojure/cascade/dom.clj
@@ -43,7 +43,7 @@
   :value ; attribute value or literal text (text must be encoded), nested nodes for :element
 )

-(declare render-xml)
+(declare render-xml debug-dom)

 (def char-to-entity-map
 	(merge
@@ -144,6 +144,29 @@
   ; TODO: Render out the <?xml version="1.0"?> P.I.?
   (doseq [node dom-nodes]
     (render-node-xml node out)))
+
+(defmulti render-node-debug
+  (fn [node & rest]
+    (node :type)))
+
+(defmethod render-node-debug :text
+	[node]
+	(node :value))
+
+(defmethod render-node-debug :comment
+	[node]
+	[:comment (node :value)])
+
+(defmethod render-node-debug :element
+	[node]
+	(let [content (node :value)]
+		[(node :name) (node :attributes) (if content (debug-dom content))]))
+
+(defn debug-dom
+	"Renders DOM nodes to a format similar to the template DSL. Returns a seq."
+	[dom-nodes]
+	(for [node dom-nodes]
+		(render-node-debug node)))

 (defn element?
   "Returns true if the dom node is type :element."


also include gzip size for modules

also include gzip size for modules

--- src/main/shadow/build/output.clj
+++ src/main/shadow/build/output.clj
@@ -8,8 +8,9 @@
             [shadow.build.data :as data]
             [clojure.set :as set]
             [shadow.build.resource :as rc])
-  (:import (java.io StringReader BufferedReader File)
-           (java.util Base64)))
+  (:import (java.io StringReader BufferedReader File ByteArrayOutputStream)
+           (java.util Base64)
+           (java.util.zip GZIPOutputStream)))

 (defn closure-defines-json [state]
   (let [closure-defines
@@ -596,13 +597,48 @@
   [{:shadow.build.closure/keys [optimized-bytes modules] :keys [build-sources] :as state}]
   (let [modules-info
         (->> modules
-             (map (fn [{:keys [module-id sources depends-on] :as mod}]
+             (map (fn [{:keys [module-id sources depends-on goog-base prepend output append] :as mod}]
                     (let [constants-name
-                          (str "shadow.cljs.module.constants." (name module-id) ".js")]
+                          (str "shadow.cljs.module.constants." (name module-id) ".js")
+
+                          shadow-js-prepend
+                          (when (= :shadow (get-in state [:js-options :js-provider]))
+                            (let [provides
+                                  (->> sources
+                                       (map #(data/get-source-by-id state %))
+                                       (filter #(= :shadow-js (:type %)))
+                                       (map #(data/get-output! state %))
+                                       (map :js)
+                                       (str/join ";\n"))]
+                              (str (when goog-base
+                                     "var shadow$provide = {};\n")
+                                   provides
+                                   (when (seq provides)
+                                     ";\n"))))
+
+                          final-output
+                          (str prepend
+                               shadow-js-prepend
+                               output
+                               append)
+
+                          bytes-out
+                          (ByteArrayOutputStream.)
+
+                          zip-out
+                          (GZIPOutputStream. bytes-out)]
+
+                      (io/copy final-output zip-out)
+                      (.flush zip-out)
+                      (.close zip-out)
+
                       {:module-id module-id
                        :sources sources
                        :depends-on depends-on
-                       :constants-size (get optimized-bytes constants-name 0)})))
+                       :constants-size (get optimized-bytes constants-name 0)
+                       :js-size (count final-output)
+                       :gzip-size (.size bytes-out)}
+                      )))
              (into []))

         src->mod


style

style

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -919,10 +919,9 @@
                            (nil? ch) (if eof-error? (err/throw-eof-error reader nil) sentinel)
                            (= ch return-on) READ_FINISHED
                            (number-literal? reader ch) (read-number reader ch)
-                           :else (let [f (macros ch)]
-                                   (if f
-                                     (f reader ch opts pending-forms)
-                                     (read-symbol reader ch)))))))]
+                           :else (if-let [f (macros ch)]
+                                   (f reader ch opts pending-forms)
+                                   (read-symbol reader ch))))))]
            (if (identical? ret reader)
              (recur)
              ret)))


A bit of cleanup in the pca code

A bit of cleanup in the pca code


fix bug in defile when

fix bug in defile when

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -97,17 +97,18 @@
   (let [{:keys [deps body doc]} (parse-task-opts forms)
         {:keys [destruct pred actions]} (parse-body body)
         {file-deps true task-deps false} (group-by string? deps)]
+    ;; TODO: fold and write some tests for this
     `(swap! tasks update '~name update-task '~deps '~doc
             (fn [~destruct]
               (let [f# (file ~name)]
                 (when (and (or (not (.exists f#))
                                (seq (filter (partial mtime< f#)
-                                            (into ~file-deps
-                                                  (map #(file ".cake" "run" (name %))
-                                                       '~task-deps))))
-                               (nil? (seq ~deps))))
-                           ~pred)
-                  ~@actions)))))
+                                            ~(into file-deps
+                                                   (map #(file ".cake" "run" (name %))
+                                                        task-deps))))
+                               (empty? '~deps))
+                           ~pred))
+                ~@actions)))))

 (defmacro undeftask [& names]
   `(swap! tasks dissoc ~@(map #(list 'quote %) names)))
@@ -250,4 +251,4 @@
     (require '[cake.tasks new]))
   (server/init-multi-out ".cake/cake.log")
   (server/create port process-command :reload reload-files :repl repl)
-  nil)
+  nil)


Add meaningful h2 log level names.

Add meaningful h2 log level names.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -163,14 +163,17 @@
   (when (not (.exists (io/file dir)))
     (str "Unable to create directory: " dir)))

-; XXX should move this to h2.clj
+; XXX should move these to h2.clj
+(def h2-log-level
+  (into {} (map vector [:off :error :info :debug :slf4j] (range))))
+
 (def ^:private default-h2-opts-map
   {:cache_size 65536
    :undo_log 1
    :log 1
    :max_query_timeout 60000
    :multi_threaded "TRUE"
-   :trace_level_file 4}) ; 4 == slf4j
+   :trace_level_file (h2-log-level :slf4j)})

 ; Enable transaction log, rollback log, and MVCC (so we can load w/o blocking readers).
 (def ^:private default-h2-opts


Improve window crash test to always recover

--- test/onyx/windowing/basic_windowing_crash_test.clj
+++ test/onyx/windowing/basic_windowing_crash_test.clj
@@ -73,13 +73,16 @@
 ;; TODO TO FIX TESTs
 ;; Remove pending-timeout
 ;; Remove extra in / out calls for core async
+(def crashed? (atom false))
+
 (def identity-crash
   {:lifecycle/handle-exception restartable?
    :lifecycle/after-read-batch (fn [event lifecycle]
-                                 (let [r (rand-int 30)]
-                                   (println "RAND?" r)
-                                   (when (and (zero? r) (not (empty? (:batch event))))
-                                     (throw (ex-info "Restart me!" {}))))
+                                 (when (and (some #(= (:id (:message %)) 16)
+                                             (:onyx.core/batch event))
+                                            (not @crashed?))
+                                   (reset! crashed? true)
+                                   (throw (ex-info "Restart me!" {})))
                                  {})})

 (defn inject-in-ch [event lifecycle]
@@ -152,11 +155,7 @@
           lifecycles
           [{:lifecycle/task :out
             :lifecycle/calls ::out-calls}
-           {:lifecycle/task :in
-            :lifecycle/calls ::identity-crash}
            {:lifecycle/task :identity
-            :lifecycle/calls ::identity-crash}
-           #_{:lifecycle/task :all
             :lifecycle/calls ::identity-crash}]
           job (-> {:catalog catalog
                    :workflow workflow


Remove unnecessary let in color-test harness.

--- test/org/playasophy/wonderdome/util/color_test.clj
+++ test/org/playasophy/wonderdome/util/color_test.clj
@@ -107,9 +107,8 @@
 (defn color-harness
   "Creates and starts a sketch to demonstrate the color utility functions."
   []
-  (let []
-    (quil/sketch
-      :title "Wonderdome Color Harness"
-      :setup setup-harness
-      :draw render-harness
-      :size [520 460])))
+  (quil/sketch
+    :title "Wonderdome Color Harness"
+    :setup setup-harness
+    :draw render-harness
+    :size [520 460]))


java stuff and proxying java methods eh

java stuff and proxying java methods eh

--- multimethods/java-interoperability.clj
+++ multimethods/java-interoperability.clj
@@ -18,3 +18,31 @@

 (println p)

+; proxy java class'
+
+;this is how we do it now for examples
+;(proxy [class-and-interface] [args] fs+)
+
+;extend the Object class
+
+(defn proxy-example
+  []
+  (proxy [Object] []
+    (toString [] "Hello World")))
+
+(println (.toString (proxy-example)))
+
+(defn proxy-collection []
+  (proxy [java.util.Collection] []
+    (add [o]
+      (println "PROXY:" o)
+      true)
+    (clear []
+      (println "proxy clearing eh")
+      true)))
+(.add (proxy-collection) "adding an item eh")
+(.add (proxy-collection) "adding something else eh")
+(.clear (proxy-collection))
+
+
+


fix reference to lexicon: it's in italiano.grammar now


Rename Jugendbücher to "Kinderbücher (ab 10)"


cleanup api controls

cleanup api controls

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -6,7 +6,7 @@
             [frontend.utils.ajax :as ajax]
             [frontend.utils.state :as state-utils]
             [frontend.utils.vcs-url :as vcs-url]
-            [frontend.utils :as utils :refer [mlog merror]]
+            [frontend.utils :as utils]
             [goog.string :as gstring])
   (:require-macros [frontend.utils :refer [inspect]]))

@@ -36,7 +36,7 @@
   (let [submethod (get-method api-event [:default status])]
     (if submethod
       (submethod target message status args state)
-      (do (merror "Unknown api: " message args)
+      (do (utils/merror "Unknown api: " message args)
           state))))

 (defmethod post-api-event! :default
@@ -45,35 +45,26 @@
   (let [submethod (get-method post-api-event! [:default status])]
     (if submethod
       (submethod target message status args previous-state current-state)
-      (merror "Unknown api: " message status args))))
+      (utils/merror "Unknown api: " message status args))))

 (defmethod api-event [:default :success]
   [target message status args state]
-  (mlog "No api for" [message status])
+  (utils/mlog "No api for" [message status])
   state)

 (defmethod post-api-event! [:default :success]
   [target message status args previous-state current-state]
-  (mlog "No post-api for: " [message status]))
+  (utils/mlog "No post-api for: " [message status]))

 (defmethod api-event [:default :failed]
   [target message status args state]
-  (mlog "No api for" [message status])
+  (utils/mlog "No api for" [message status])
   state)

 (defmethod post-api-event! [:default :failed]
   [target message status args previous-state current-state]
   (put! (get-in current-state [:comms :errors]) [:api-error args])
-  (mlog "No post-api for: " [message status]))
-
-(defmethod api-event [:default :finished]
-  [target message status args state]
-  (mlog "No api for" [message status])
-  state)
-
-(defmethod post-api-event! [:default :finished]
-  [target message status args previous-state current-state]
-  (mlog "No post-api for: " [message status]))
+  (utils/mlog "No post-api for: " [message status]))

 (defmethod api-event [:entity-ids :success]
   [target message status args state]


Tweak tree-shake's docstring & add preconditions

--- src/oxcart/passes/tree_shake.clj
+++ src/oxcart/passes/tree_shake.clj
@@ -88,10 +88,14 @@

   options:

-    :entry is a symbol, presumably a namespace qualified -main var,
-    which is the entry point of the prorgam. It is with respect to this
-    function that all other defs will be considered for elimination."
+    :entry is a symbol, presumably a namespace qualified -main, which
+    is the entry point of the prorgam. It is with respect to this
+    function that all other defs in all loaded namespaces will be
+    considered for elimination."
   [{:keys [modules] :as ast} {:keys [entry] :as options}]
+  {:pre [(every? symbol? modules)
+         (symbol? entry)
+         (every? (partial contains? ast) modules)]}
   (let [;; Compute the {Var → #{Var}} form of the whole program
         symbol-sets (->>  (for [m     modules
                                 form  (:forms (get ast m))


Fixed typo

Fixed typo

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -31,7 +31,7 @@
   (remove #(not (active? (uploads %1))) uploads-order))

 (defn inactive-uploads [uploads-order uploads]
-  "Returns al list of inactive upload IDs"
+  "Returns a list of inactive upload IDs"
   (remove #(active? (uploads %1)) uploads-order))

 (defn get-action [old-state new-state upload-id]


cleaned up a bit

cleaned up a bit

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -57,29 +57,29 @@
 (defn handle-state-change [old-state new-state]
   "Returns new state map according to changes between old-state and new-state"
   (let [uploads (:uploads new-state)
-        room-uploads-order (:client-uploads-order new-state)
+        uploads-order (:client-uploads-order new-state)
+        old-uploads-order (:client-uploads-order old-state)
         upload-slots (:upload-slots new-state)
-        active-uploads (active-uploads room-uploads-order uploads)
-        inactive-uploads (inactive-uploads room-uploads-order uploads)
-        unpaused-inactive-uploads (remove #(:paused? (uploads %)) inactive-uploads)
-        new-upload-ids (set/difference (set (:client-uploads-order new-state))
-                                       (set (:client-uploads-order old-state)))
-        removed-upload-ids (set/difference (set (:client-uploads-order old-state))
-                                           (set (:client-uploads-order new-state)))]
+        active-uploads (active-uploads uploads-order uploads)
+        inactive-uploads (inactive-uploads uploads-order uploads)
+        unpaused-inactive-uploads (remove #(:paused? (uploads %))
+                                          inactive-uploads)
+        new-upload-ids (set/difference (set uploads-order)
+                                       (set old-uploads-order))
+        removed-upload-ids (set/difference (set old-uploads-order)
+                                           (set uploads-order))]
     (cond
-      (and (not (empty? new-upload-ids))
-           (<= (count room-uploads-order) upload-slots))
-      (assoc-in new-state
-                [:uploads (first new-upload-ids)]
-                (start (uploads (first new-upload-ids))))
-
-      (and (and (not (empty? removed-upload-ids))
-                (not (empty? unpaused-inactive-uploads)))
-           (< (count active-uploads)
-              upload-slots))
-      (assoc-in new-state
-                [:uploads (first unpaused-inactive-uploads)]
-                (start (uploads (first unpaused-inactive-uploads))))
+      (< (count active-uploads) upload-slots)
+      (assoc new-state
+             :uploads
+              (reduce #(update % %2 start)
+                      uploads
+                      (take (- upload-slots
+                            (count active-uploads))
+                      uploads-order)))
+
+      ;(> (count active-uploads) upload-slots)
+      ;new-state

       :else new-state)))


fixed max upload slots

fixed max upload slots

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -69,7 +69,7 @@
                                                    (set (:client-uploads-order new-state)))]
     (cond
       (and (not (empty? new-upload-ids))
-           (< (count room-uploads-order) upload-slots))
+           (<= (count room-uploads-order) upload-slots))
       (assoc new-state
              :uploads
              (assoc uploads


Fix timezone issue in test

Fix timezone issue in test

--- test/buildviz/controllers/builds_test.clj
+++ test/buildviz/controllers/builds_test.clj
@@ -182,10 +182,10 @@

   (testing "should return CSV"
     (let [app (the-app {"someBuild" {"42" {:start a-timestamp :end (+ a-timestamp half-an-hour) :outcome "fail"}}
-                        "anotherBuild" {1 {:start 1}}}
+                        "anotherBuild" {1 {:start (- a-timestamp half-an-hour)}}}
                        {})]
       (is (= (str/join "\n" ["job,buildId,start,end,outcome"
-                             "anotherBuild,1,1970-01-01 01:00:00,,"
+                             "anotherBuild,1,1986-10-14 03:33:27,,"
                              "someBuild,42,1986-10-14 04:03:27,1986-10-14 04:33:27,fail"
                              ""])
              (:body (get-request app "/builds")))))))


Fi test

Fi test

--- test/com/wsscode/pathom/connect_test.cljc
+++ test/com/wsscode/pathom/connect_test.cljc
@@ -1463,22 +1463,23 @@
                         (pc/add 'abc #::pc{:input #{:customer/id} :output [:customer/name]}))]
     (is (= (pc/reprocess-index dirty-index)
            '#:com.wsscode.pathom.connect{:index-attributes {#{:customer/id
-                                                              :customer/wrong} #:com.wsscode.pathom.connect{:attribute     #{:customer/id
-                                                                                :customer/wrong}
-                                                                                :attr-input-in #{abc}
-                                                                                :attr-provides #:customer{:name #{abc}}}
-                                                            :customer/id       #:com.wsscode.pathom.connect{:attribute         :customer/id
-                                                                                :attr-combinations #{#{:customer/id
+                                                              :customer/wrong} #:com.wsscode.pathom.connect{:attr-input-in #{abc}
+                                                                                :attr-provides #:customer{:name #{abc}}
+                                                                                :attribute     #{:customer/id
+                                                                                :customer/wrong}}
+                                                            :customer/id       #:com.wsscode.pathom.connect{:attr-combinations #{#{:customer/id
                                                                                :customer/wrong}}
-                                                                                :attr-input-in     #{abc}}
-                                                            :customer/name     #:com.wsscode.pathom.connect{:attribute      :customer/name
+                                                                                :attr-input-in     #{abc}
+                                                                                :attribute         :customer/id}
+                                                            :customer/name     #:com.wsscode.pathom.connect{:attr-leaf-in   #{abc}
                                                                                :attr-output-in #{abc}
                                                                                :attr-reach-via {#{:customer/id
-                                                                                :customer/wrong} #{abc}}}
-                                                            :customer/wrong    #:com.wsscode.pathom.connect{:attribute         :customer/wrong
-                                                                                :attr-combinations #{#{:customer/id
+                                                                                :customer/wrong} #{abc}}
+                                                                                :attribute      :customer/name}
+                                                            :customer/wrong    #:com.wsscode.pathom.connect{:attr-combinations #{#{:customer/id
                                                                                :customer/wrong}}
-                                                                                :attr-input-in     #{abc}}}
+                                                                                :attr-input-in     #{abc}
+                                                                                :attribute         :customer/wrong}}
                                          :index-io         {#{:customer/id
                                                               :customer/wrong} #:customer{:name {}}}
                                          :index-oir        #:customer{:name {#{:customer/id


add PLossFunction protocol

add PLossFunction protocol

--- src/cortex/protocols.clj
+++ src/cortex/protocols.clj
@@ -42,4 +42,11 @@
   (compute-parameters
     [optimiser gradient parameters]
      "Computes updated parameters using the given average gradient. Returns the updated gradient optimiser.
-      Users can then call `parameters` on this object to get the updated parameters"))+      Users can then call `parameters` on this object to get the updated parameters"))
+
+(defprotocol PLossFunction
+  "A function that calculates loss of a vector output vs. a target value"
+  (loss [this v target]
+    "Computes the loss for a value v against a target")
+  (loss-gradient [this v target]
+    "Computes the gradient of the loss with respect to v"))


Fix the defn of f.m.project/oss? (we don't have github-info, api delivers features flag value.)

--- frontend/models/project.cljs
+++ frontend/models/project.cljs
@@ -63,10 +63,9 @@
 (defn id [project]
   (:vcs_url project))

-;; TODO: this is annoying; it's replicating code in
-;; circle.model.project/oss? ... is there some easy way around that?
+;; I was confused, on the backend, we now default to oss if
+;; github-info shows it to be public and no one sets the flag
+;; explicitly to false. But the read-api always delivers the frontend
+;; a feature_flags oss set to true for those cases.
 (defn oss? [project]
-  (let [feature-flag (get-in project [:feature_flags :oss])
-        gh-private (get-in project [:github-info :private])]
-    (and (or (nil? feature-flag) (true? feature-flag))
-         (not gh-private))))
+  (get-in project [:feature_flags :oss]))


Test for asciidoc syntax highlighting

Test for asciidoc syntax highlighting

--- test/io/perun_test.clj
+++ test/io/perun_test.clj
@@ -201,13 +201,21 @@

 (def adoc-input-strings (map #(str (meta-block %) adoc-content) yamls))

-(def highlight-input-string
+(def highlight-input-md-string
   (str
    (meta-block (yaml/generate-string (assoc base-meta :uuid "f948c938-3cf2-4feb-bf02-f284c2fe9665")))
    "```scss
 @import 'bootstrap';
 ```"))

+(def highlight-input-ad-string
+  (str
+   (meta-block (yaml/generate-string (assoc base-meta :uuid "ce14e4fc-8c65-4e26-94fe-55faaa650c01")))
+   "[source,scss]
+----
+@import 'bootstrap';
+----"))
+
 (def parsed-md-basic "
Hello there
\n
This --- be markdown.
\n")

 (def parsed-pandoc-basic "
Hello there
\n
This --- be markdown.
\n")
@@ -219,6 +227,8 @@
 (def parsed-md-smarts "
Hello there
\n
This — be markdown.
\n")

 (def highlighted-md "
@import 'bootstrap';\n
")
+
+(def highlighted-ad "
@import 'bootstrap';\n
")

 (def js-content "(function somejs() { console.log('$foo'); })();")

@@ -292,13 +302,22 @@
                          :content parsed-md-basic
                          :msg "`markdown` should populate HTML file with parsed content"))

-        (add-txt-file :path "highlight-test.md" :content highlight-input-string)
+        (add-txt-file :path "highlight-test.md" :content highlight-input-md-string)
         (p/markdown)
         (p/highlight)

-        (testing "highlight"
+        (testing "highlight for markdown"
           (content-check :path (perun/url-to-path "public/highlight-test.html")
                          :content highlighted-md
+                         :msg "`highlight` should add Pygments syntax highlighting to HTML file"))
+
+        (add-txt-file :path "highlight-test.ad" :content highlight-input-ad-string)
+        (p/asciidoctor)
+        (p/highlight)
+
+        (testing "highlight for asciidoc"
+          (content-check :path (perun/url-to-path "public/highlight-test.html")
+                         :content highlighted-ad
                          :msg "`highlight` should add Pygments syntax highlighting to HTML file"))

         (p/ttr)


Added helper for tunneling to SIT.

Added helper for tunneling to SIT.

--- dev/user.clj
+++ dev/user.clj
@@ -11,7 +11,8 @@
             [cmr.common.config :as cfg])
   (:use [clojure.test :only [run-all-tests]]
         [clojure.repl]
-        [alex-and-georges.debug-repl]))
+        [alex-and-georges.debug-repl]
+        [cmr.common.dev.capture-reveal]))

 (def system nil)

@@ -56,11 +57,33 @@
   (cfg/set-config-value! :echo-system-token "XXXXX")
   (cfg/set-config-value! :metadata-db-password "XXXXX"))

+(defn tunnel-system-sit
+  "Allows tunneling the search to a indexer and elasticsearch running on a different system"
+  []
+  ;; sit can be tunnelled by running these
+  ;; ssh -L4005:localhost:3005 cmr-sit-app1.dev.echo.nasa.gov
+  ;; ssh -L9212:localhost:9200 cmr-sit-elastic1.dev.echo.nasa.gov
+  ;; ssh -L1558:tbdb.dev.echo.nasa.gov:1521 tbkernel4.dev.echo.nasa.gov
+  (cfg/set-config-value! :elastic-port 9212)
+  (cfg/set-config-value! :index-set-port 4005)
+
+  (cfg/set-config-value! :echo-rest-protocol "https")
+  (cfg/set-config-value! :echo-rest-host "testbed.echo.nasa.gov")
+  (cfg/set-config-value! :echo-rest-port 443)
+  (cfg/set-config-value! :echo-rest-context "/echo-rest")
+
+  (cfg/set-config-value! :db-url "thin:@localhost:1558/tbdb.dev.echo.nasa.gov")
+
+  ;; Set the following but do not commit them
+  (cfg/set-config-value! :echo-system-token "XXXXXX")
+  (cfg/set-config-value! :metadata-db-password "XXXXXX"))
+
 (defn create-system
   []
   ;; Uncomment this to tunnel to another system for testing.
   ; (tunnel-system-uat)
   ; (tunnel-system-wl)
+  ; (tunnel-system-sit)

   ;; Set the default job start delay to avoid jobs kicking off with tests etc.
   (cfg/set-config-value! :default-job-start-delay (str (* 3 3600)))


Helper function to build deprecations lists

--- test/onyx/doc_test.clj
+++ test/onyx/doc_test.clj
@@ -78,3 +78,12 @@
            (map (fn [k]
                   (set (model-display-order k)))
                 (keys model))))))
+
+
+(comment (defn build-deprecations-strings [version]
+           (mapcat (fn [[category deps]]
+                  (map (fn [feature]
+                         (format "- [%s](http://www.onyxplatform.org/docs/cheat-sheet/0.10.0/#%s/%s)" feature category feature))
+                       deps))
+                (onyx.information-model/version-deprecations "0.10.0"))))
+


remove extra file

remove extra file


handle goto definition for jars and local files


Fix missing paren in riemann-config.clj

Fix missing paren in riemann-config.clj

--- satellite-master/config/riemann-config.clj
+++ satellite-master/config/riemann-config.clj
@@ -31,4 +31,4 @@
         (coalesce (* 60 5)
                   prn
                   (where* (fn [es] (< (:metric (folds/sum es)) 10)
-                          (email "foo@example.com")))))
+                          (email "foo@example.com"))))))


Fix more tests.

Fix more tests.

--- test/onyx/coordinator/multi_peer_test.clj
+++ test/onyx/coordinator/multi_peer_test.clj
@@ -30,6 +30,10 @@

            sync-spy-a (chan 1)
            sync-spy-b (chan 1)
+
+           seal-spy-a (chan 1)
+           seal-spy-b (chan 1)
+
            ack-ch-spy (chan 2)
            offer-ch-spy (chan 10)
            status-spy (chan 2)
@@ -127,6 +131,14 @@
                                          :payload-node (:node payload-node-b-2)})
                 (extensions/on-change sync (:node payload-node-b-2) #(>!! sync-spy-b %))

+                (extensions/on-change sync (:node/seal (:nodes payload-a)) #(>!! seal-spy-a %))
+                (extensions/touch-node sync (:node/exhaust (:nodes payload-a)))
+                (<!! seal-spy-a)
+
+                (extensions/on-change sync (:node/seal (:nodes payload-b)) #(>!! seal-spy-b %))
+                (extensions/touch-node sync (:node/exhaust (:nodes payload-b)))
+                (<!! seal-spy-b)
+
                 (extensions/touch-node sync (:node/completion (:nodes payload-a)))
                 (extensions/touch-node sync (:node/completion (:nodes payload-b)))

@@ -140,6 +152,10 @@

                   (<!! ack-ch-spy)
                   (<!! status-spy)
+
+                  (extensions/on-change sync (:node/seal nodes) #(>!! seal-spy-a %))
+                  (extensions/touch-node sync (:node/exhaust nodes))
+                  (<!! seal-spy-a)

                   (extensions/touch-node sync (:node/completion nodes))
                   (<!! offer-ch-spy))
@@ -167,6 +183,7 @@
            shutdowns (take n (repeatedly (fn [] (extensions/create sync :shutdown))))
            payloads (take n (repeatedly (fn [] (extensions/create sync :payload))))
            sync-spies (take n (repeatedly (fn [] (chan 1))))
+           seal-spies (take n (repeatedly (fn [] (chan 1))))

            status-spy (chan (* n 5))
            offer-ch-spy (chan (* n 5))
@@ -193,7 +210,7 @@
        (tap (:offer-mult coordinator) offer-ch-spy)
        (tap (:ack-mult coordinator) ack-ch-spy)

-       (doseq [[peer pulse shutdown payload sync-spy]
+       (doseq [[peer pulse shutdown payload sync-spy seal-spy]
                (map vector peers pulses shutdowns payloads sync-spies)]
          (extensions/write-node sync (:node peer)
                                  {:id (:uuid peer)
@@ -249,6 +266,10 @@

            (doseq [payload-node payload-nodes]
              (let [payload (extensions/read-node sync payload-node)]
+               (extensions/on-change sync (:node/seal (:nodes payload)) #(>!! (first seal-spies) %))
+               (extensions/touch-node sync (:node/exhaust (:nodes payload)))
+               (<!! (first seal-spies))
+
                (extensions/touch-node sync (:node/completion (:nodes payload)))
                (<!! offer-ch-spy)))))


as-geojson using keywords

as-geojson using keywords

--- src/dwc_analysis/geo.clj
+++ src/dwc_analysis/geo.clj
@@ -19,6 +19,14 @@
 (def c geom/c)
 (def area geom/area)
 (def utm transform/utmzone)
+(def intersects? relation/intersects?)
+
+(defn distance-in-meters
+  ([p0 p1] (distance-in-meters p0 p1 "EPSG:4326"))
+  ([p0 p1 crs]
+    (analysis/distance
+      (transform/reproject p0 crs (utm p0))
+      (transform/reproject p1 crs (utm p1)))))

 (defn area-in-meters
   ""
@@ -52,5 +60,5 @@
   ""
   [feature]
   (if (nil? feature) nil
-    (read-str (io/write-geojson feature))))
+    (read-str (io/write-geojson feature) :key-fn keyword)))


Use newer snapshot version of cljunit and expose new listeners option

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -6,7 +6,7 @@
             [clojure.string :as str]))

 (def pod-deps
-  '[[radicalzephyr/cljunit "0.2.0"]])
+  '[[radicalzephyr/cljunit "0.3.0-SNAPSHOT"]])

 (defn- init [fresh-pod]
   (pod/with-eval-in fresh-pod
@@ -35,6 +35,7 @@
 (core/deftask junit
   "Run the jUnit test runner."
   [c class-names  CLASSNAME #{str} "The set of Java class names to run tests from."
+   l listeners    CLASSNAME #{str} "The set of JUnit RunListener classes to add."
    p packages     PACKAGE   #{str} "The set of package names to run tests from."]
   (let [worker-pods (pod/pod-pool (update-in (core/get-env) [:dependencies] into pod-deps)
                                   :init init)]
@@ -50,6 +51,7 @@
                           (pod/with-eval-in worker-pod
                            (run-tests-in-classes '~all-class-names
                                                  :classes ~class-names
+                                                 :listeners ~listeners
                                                  :packages ~packages))
                           (catch ClassNotFoundException e
                             (util/warn "Could not load class: %s...\n" (.getMessage e))


Return empty model from SPARQL CONSTRUCT if invalid syntax error is thrown

--- src/rdf_path_examples/sparql.clj
+++ src/rdf_path_examples/sparql.clj
@@ -3,11 +3,12 @@
             [rdf-path-examples.type-inference :as infer]
             [rdf-path-examples.prefixes :as prefix]
             [clojure.tools.logging :as log])
-  (:import [org.apache.jena.rdf.model Literal Model Resource]
+  (:import [org.apache.jena.rdf.model Literal Model ModelFactory Resource]
            [org.apache.jena.query Dataset QueryExecutionFactory QueryFactory]
            [org.apache.jena.update UpdateAction UpdateFactory]
            [org.apache.jena.datatypes.xsd XSDDatatype]
-           [org.apache.jena.datatypes BaseDatatype$TypedValue DatatypeFormatException]))
+           [org.apache.jena.datatypes BaseDatatype$TypedValue DatatypeFormatException]
+           [org.apache.jena.riot RiotParseException]))

 ; ----- Multimethods -----

@@ -104,7 +105,12 @@
   [^String endpoint
    ^String query]
   (with-open [qexec (QueryExecutionFactory/sparqlService endpoint query)]
-    (.execConstruct qexec)))
+    (try
+      (.execConstruct qexec)
+      ; If there is a non-recoverable syntax error, log it, and return an empty model.
+      (catch RiotParseException ex
+        (log/info (.getMessage ex))
+        (ModelFactory/createDefaultModel)))))

 (defn ^Model describe-query
   "Execute SPARQL DESCRIBE `query` on local RDF `model`."


Handle subdir in repo-handler so that other configurations don't need to.

--- src/circle/backend/proto/src/proto/main.clj
+++ src/circle/backend/proto/src/proto/main.clj
@@ -50,14 +50,14 @@

 (defn repo-handler
   [{repo :repo
-    subdir :subdir}]
+    subdir :subdir :or ""}]
   (let [dir "scratch/"
         tar-file (str dir "tip.tar.bz2")]
                                         ; for now, assume it's mercurial
     (do
       (download (str repo "/archive/tip.tar.bz2") tar-file)
       (untar tar-file dir)
-      {:srcdir (tar-get-directory tar-file)})))
+      {:srcdir (str (tar-get-directory tar-file) "/"  subdir)})))

 (def handlers [repo-handler autotools-handler])


reset player-log data when (re-)opening player-log

--- src/cljs/foosball/locations/player-log.cljs
+++ src/cljs/foosball/locations/player-log.cljs
@@ -13,6 +13,7 @@
       (data/go-update-data! "/api/players" app :players))
     (om/update! app :player-log-player ())
     (om/update! app :players nil)
+    (om/update! app :player-log nil)
     (when player-id
       (do
         (om/update! app :player-log-player (uuid/make-uuid-from player-id))


admin create correctly changes state

admin create correctly changes state

--- src/cljs/swarmpit/component/page_login.cljs
+++ src/cljs/swarmpit/component/page_login.cljs
@@ -39,9 +39,11 @@
   [local-state]
   (ajax/post
     (routes/path-for-backend :initialize)
-    {:params (select-keys @local-state [:username :password])
-     :on-success (fn [{:keys [response]}]
-                   (login-handler local-state))
+    {:headers nil
+     :params (select-keys @local-state [:username :password])
+     :on-success (fn [_]
+                   (login-handler local-state)
+                   (state/set-value true [:initialized]))
      :on-error   (fn [{:keys [response]}]
                    (swap! local-state assoc :message (:error response)))}))


4clojure:: impl the euler-totient-fn: find/count all the nums which are less than + coprime to the given number

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -3099,13 +3099,12 @@
                (list) nested-xs))]
     (reverse (flatten-to-one-level nested-xs))))

-(partial-flatten [ [ [[:a :b]] [:foo :bar] ], [[:c :d]], [:e :f] ])
-(partial-flatten [[[[:a :b]]] [[:c :d]] [:e :f]])
-(partial-flatten '( (1 2), ((3 4), ((((5 6)))))))
-(partial-flatten  [["Do"] ["Nothing"]])
-
-
-((comp not every?) (complement sequential?) [1 2 [3 4]]) ;; true
+(partial-flatten [[[[:a :b]]] [[:c :d]] [[:e :f]]]) ;; ([:a :b] [:c :d] [:e :f])
+(partial-flatten '( (1 2), ((3 4), ((((5 6)))))))   ;; ((1 2) (3 4) (5 6))
+(partial-flatten  [["Do"] ["Nothing"]])             ;; (["Do"] ["Nothing"])
+
+
+((comp not every?) sequential? [1 2 [3 4]]) ;; true

 (defn nested-more-than-one? [xs]
   (letfn [(nested?
@@ -3117,3 +3116,32 @@

 ;; demo:
 (nested-more-than-one? [[[:a :b]]]) ;; true
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;; Euler's Totient Function
+;; Difficulty:	Medium
+;; Two numbers are coprime if their greatest common divisor equals 1.
+;; Euler's totient function f(x) is defined as the number of positive integers less than x which are coprime to x.
+;; (= (__ 10) (count '(1 3 7 9)) 4)
+;; (= (__ 40) 16)
+;; (= (__ 1) 1)
+(defn gcd [a b]
+  (if (zero? b) a
+    (gcd b (rem a b))))
+
+(defn euler-totient-fn [x]
+  (letfn [(gcd [a b]
+            (if (zero? b) a
+              (gcd b (rem a b))))
+          (coprime? [x y]
+            (= 1 (gcd x y)))]
+    (count
+       (reduce
+          (fn [acc each]
+            (if (coprime? x each)
+              (conj acc each)
+              acc))
+          [] (range 1 (inc x))))))
+
+(euler-totient-fn 40)  ;; 16, but without [count] looks like:  [1 3 7 9 11 13 17 19 21 23 27 29 31 33 37 39]
+(euler-totient-fn 1)   ;; 1


Small comment fix.

Small comment fix.

--- EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
@@ -1399,7 +1399,7 @@

 (defn
   pointcutdefinition-concretizedby
-  "Relation of (possibly abstract) pointcut definitions and their concretizing (definitely concrete) pointcuts."
+  "Relation of (possibly abstract) pointcut definitions and their concretizing (definitely concrete) pointcut definitions."
   [?abstractpc ?concretepc]
   (fresh [?abaspect ?concaspect ?name]
          (aspect|abstract ?abaspect)


Ancestors, most enclosing type declaration of IProgramElement instances. Link between type declaration IProgramElement instances and ResolvedType instances from the weaver world.

--- EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
@@ -130,6 +130,7 @@
     (element ?element)
     (equals ?kind (.getKind ?element))))

+;todo: check how this behaves for generic types, align with weaverworld-signature-resolvedtype
 (defn
   element-signature
   "Relation between a ProgramElement and its signature string."
@@ -156,35 +157,78 @@

-(defn
+(defn-
   ancestors-of-element
-  "Returns the lazy sequence of non-nil ancestors of the given ProgramElement. "
-  [element]
-  (filter (complement nil?)
-          (iterate (fn [ancestor] (.getParent ancestor)))))
-
-
-
-
-
-
-
-
-
-;does not work yet
-(defn
-  element-enclosing-aspect
+  "Returns the ancestor chain of the given ProgramElement.
+   First element is the immediate parent."
+  ([element]
+    (ancestors-of-element (.getParent element) []))
+  ([parent sofar]
+    (if-not
+      (nil? parent)
+      (recur (.getParent parent) (conj sofar parent))
+      sofar)))
+
+(defn-
+  enclosingtypedeclaration-of-element
+  "Returns the most enclosing class, aspect or enum declaration
+   in which the given ProgramElement resides."
+  [element]
+  (letfn [(typedeclaration?
+            [element]
+            (let [kind (.getKind element)]
+              (or (= kind (IProgramElement$Kind/CLASS))
+                  (= kind (IProgramElement$Kind/ENUM))
+                  (= kind (IProgramElement$Kind/ASPECT)))))
+          (ancestortypedeclaration
+            [parent]
+            (if-not
+              (nil? parent)
+              (if
+                (typedeclaration? parent)
+                parent
+                (recur (.getParent parent)))))]
+         (ancestortypedeclaration (.getParent element))))
+
+(defn
+  element-enclosingtypedeclaration-element
   "Relation between a ProgramElement and its enclosing aspect (if any)."
-  [?element ?aspect]
-  (fresh [?aspkind]
-         (equals ?aspkind (IProgramElement$Kind/ASPECT))
-         (conde [(element-parent ?element ?aspect)
-                 (!= ?aspect nil)
-                 (element-kind ?aspect ?aspkind)]
-                [(fresh [?intermediate]
-                        (element-parent ?element ?intermediate)
-                        (element-enclosing-aspect ?element ?aspect))])))
-
+  [?element ?typedeclaration]
+  (all
+    (element ?element)
+    (equals ?typedeclaration (enclosingtypedeclaration-of-element ?element))
+    (!= nil ?typedeclaration)))
+
+(defn
+  elementaspect
+  [?element]
+  (all
+    (element ?element)
+    (equals (IProgramElement$Kind/ASPECT) (.getKind ?element))))
+
+(defn
+  elementclass
+  [?element]
+  (all
+    (element ?element)
+    (equals (IProgramElement$Kind/CLASS) (.getKind ?element))))
+
+(defn
+  elementenum
+  [?element]
+  (all
+    (element ?element)
+    (equals (IProgramElement$Kind/ENUM) (.getKind ?element))))
+
+(defn
+  elementtypedeclaration
+  [?element]
+  (conde
+    [(elementenum ?element)]
+    [(elementclass ?element)]
+    [(elementaspect ?element)]))
+
+

@@ -212,6 +256,7 @@
        (equals ?resolvedtype (.getValue ?entry))))

 ;can be used to go from xcut to weaverworld types
+;todo: check how this behaves for generic types, align with element-signature
 (defn
   weaverworld-signature-resolvedtype
   "Non-relational. Unifies ?resolved-type with the type known to the AspectJ weaver
@@ -219,7 +264,21 @@

    Can be used to go from XCut types to weaver world types."
   [?world ?signature ?resolved-type]
-  (equals ?resolved-type (.lookupBySignature ?world ?signature)))
+  (equals ?resolved-type (.resolve ?world ?signature)))
+
+
+(defn
+  element-type
+  "Relation between a ProgramElement of kind Aspect/Enum/Class
+   and the ResolvedType instance from the weaver world it corresponds to."
+  [?element ?type]
+  (fresh [?world ?signature]
+         (elementtypedeclaration ?element)
+         (element-signature ?element ?signature)
+         (weaverworld ?world) ;todo: go straight from element to correct weaverworld (see weaverworld-model-hierarchy)
+         (weaverworld-signature-resolvedtype ?world ?signature ?type)))
+
+

 (defn
@@ -868,7 +927,6 @@

-
 ;;todo:
 ;;take into account kinds of advice
 ;;implicit precedence, precedence assumption


use preterito-stem in all contexts: no "boot rule"

--- src/babel/espanol/morphology/verbs.clj
+++ src/babel/espanol/morphology/verbs.clj
@@ -504,18 +504,7 @@
         stem (string/replace infinitive #"[iae]r$" "")

         stem (if (get-in word [:preterito-stem])
-               (cond  (and usted ;; if we in usted mode, and person is 2nd.
-                           (= :2nd (get-in word [:agr :person])))
-                      (get-in word [:preterito-stem])
-
-                      (and ustedes  ;; if we in ustedes mode, and person is 2nd.
-                           (= :2nd (get-in word [:agr :person])))
-                      (get-in word [:preterito-stem])
-
-                      (= :3rd (get-in word [:agr :person]))
-                      (get-in word [:preterito-stem])
-                      true
-                      stem)
+               (get-in word [:preterito-stem])
                stem)

         last-stem-char-is-i (re-find #"ir$" infinitive)


Forgot to adjust c.c.gui.editors.contexts

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

--- src/conexp/contrib/gui/editors/contexts.clj
+++ src/conexp/contrib/gui/editors/contexts.clj
@@ -17,9 +17,8 @@
 	[conexp.layout.base :only (lattice)]
 	conexp.graphics.draw
 	conexp.contrib.gui.util
-        conexp.contrib.gui.editors.util
         conexp.contrib.gui.editors.context-editor
-        [conexp.contrib.gui.editors.context-editor.util :only (get-current-second-operand-context)]
+        [conexp.contrib.gui.editors.context-editor.context-editor :only (get-current-second-operand-context)]
 	conexp.contrib.gui.plugins.base)
   (:use clojure.contrib.swing-utils
 	[clojure.contrib.io :exclude (spit)]


change error CSS class to error-message

change error CSS class to error-message

--- src/ez_form/decorate.clj
+++ src/ez_form/decorate.clj
@@ -10,7 +10,7 @@
                                     :wrapper :div}
                             :?help {:css {:class "help"}
                                     :wrapper :div}
-                            :?error {:css {:class "error"}
+                            :?error {:css {:class "error-message"}
                                      :wrapper :div}})

 (defn add-decor [decor field]


Add comments

Add comments

--- src/braid/server/routes/api/public.clj
+++ src/braid/server/routes/api/public.clj
@@ -30,11 +30,13 @@

 (defroutes api-public-routes

+  ; get current logged in user
   (GET "/session" req
     (if-let [user (user-from-session req)]
       (edn-response user)
       {:status 401 :body "" :session nil}))

+  ; log in
   (PUT "/session" [email password :as req]
     (if-let [user-id (when (and email password)
                        (db/authenticate-user email password))]
@@ -42,9 +44,11 @@
        :session (assoc (req :session) :user-id user-id)}
       (error-response 401 :auth-fail)))

+  ; log out
   (DELETE "/session" _
     {:status 200 :session nil})

+  ; register a user
   (PUT "/users" [email password :as req]
     (cond
       (string/blank? email)


Span navbar to the whole page width.

Span navbar to the whole page width.

--- src/clj/hatnik/web/server/renderer.clj
+++ src/clj/hatnik/web/server/renderer.clj
@@ -38,30 +38,31 @@

 (defn page-menu [config user]
   [:nav.navbar.navbar-default {:role "navigation"}
-   [:div.navbar-header
-    [:button.navbar-toggle {:type "button"
-                            :data-toggle "collapse"
-                            :data-target ".navbar-collapse"}
-     [:span.sr-only "Toggle navigation"]
-     [:span.icon-bar]
-     [:span.icon-bar]
-     [:span.icon-bar]]
-    [:a.navbar-brand {:href "/"} "Hatnik"]]
+   [:div.container
+    [:div.navbar-header
+     [:button.navbar-toggle {:type "button"
+                             :data-toggle "collapse"
+                             :data-target ".navbar-collapse"}
+      [:span.sr-only "Toggle navigation"]
+      [:span.icon-bar]
+      [:span.icon-bar]
+      [:span.icon-bar]]
+     [:a.navbar-brand {:href "/"} "Hatnik"]]

-   [:div#navbarCollapse.collapse.navbar-collapse
-    (if user
-      ; User logged in
-      [:ul.nav.navbar-nav.navbar-right
-       [:li
-        [:a (:github-login user)]]
-       [:li
-        [:a.btn {:href "/api/logout"} "Logout"]]]
+    [:div#navbarCollapse.collapse.navbar-collapse
+     (if user
+                                        ; User logged in
+       [:ul.nav.navbar-nav.navbar-right
+        [:li
+         [:a (:github-login user)]]
+        [:li
+         [:a.btn {:href "/api/logout"} "Logout"]]]

-      ; User is not logged in
-      [:ul.nav.navbar-nav.navbar-right
-       [:li
-        [:a.btn
-         {:href (github-link config)} "Login via GitHub"]]])]])
+                                        ; User is not logged in
+       [:ul.nav.navbar-nav.navbar-right
+        [:li
+         [:a.btn
+          {:href (github-link config)} "Login via GitHub"]]])]]])

 (defn work-main-page []
   (hc/html
@@ -120,8 +121,9 @@
    (page-html-head)

    [:body
+    (page-menu config user)
+
     [:div.container
-     (page-menu config user)

      (if user
        (work-main-page)


fix badge lookup

fix badge lookup

--- src/clj/salava/metabadge/metabadge.clj
+++ src/clj/salava/metabadge/metabadge.clj
@@ -12,12 +12,15 @@
             [salava.badge.main :as b]
             [salava.core.helper :refer [dump]]
             [clojure.set :as s]
-            [medley.core :refer [distinct-by]]))
-
-(def no-of-days-in-cache 30)
-
-(defonce metabadge-cache-storage (atom (-> {} (cache/lru-cache-factory :threshold 100) (cache/ttl-cache-factory :ttl (* (* 86400 1000) no-of-days-in-cache)))))
-(defonce user-badge-cache-storage (atom (-> {} (cache/lru-cache-factory :threshold 500) (cache/ttl-cache-factory :ttl (* 86400 1000)))))
+            [medley.core :refer [distinct-by]]
+            [yesql.core :refer [defqueries]]))
+
+(defqueries "sql/metabadge/queries.sql")
+
+(def no-of-days-in-cache 3)
+
+(defonce metabadge-cache-storage (atom (-> {} (cache/lru-cache-factory :threshold 200) (cache/ttl-cache-factory :ttl (* (* 86400 1000) no-of-days-in-cache)))))
+;(defonce user-badge-cache-storage (atom (-> {} (cache/lru-cache-factory :threshold 500) (cache/ttl-cache-factory :ttl (* 86400 1000)))))

 (defn url? [s]
   (not (clojure.string/blank? (re-find #"^http" (str s)))))
@@ -64,38 +67,83 @@

 (defn get-badge-data [ctx badge]
-  (let [id (:id badge)
-        key (keyword id)]
+  (let [key (:id badge)]
     (cache/lookup (swap! metabadge-cache-storage
                          #(if (cache/has? % key)
                             (cache/hit % key)
-                            (cache/miss % key (public-badge-info ctx id)))) key)))
-
-(defn- expand-required-badges [ctx badges assertion-url]
-  (->> badges
-       (r/map (fn [b] (-> b (assoc :badge-info (dissoc (get-badge-data ctx b) :language :alt_language :tags :id)
-                              :current (= (:url b) assertion-url)
-                              :user_badge (db/user-badge-by-assertion ctx (:url b))))) )
-       (r/foldcat)))
-
+                            (cache/miss % key (public-badge-info ctx key)))) key)))
+
+(defn lookup-badge
+  "first check db for badge-info, if not in db perform cache lookup"
+  [ctx metabadge_id option badge]
+  (-> badge
+      (dissoc :id)
+      (merge (if (:received badge)
+               (-> (db/user-badge-by-assertion ctx (:url badge)) first)
+               (if option
+                 (if-let [metabadge (->> (select-factory-metabadge {:id metabadge_id} (u/get-db ctx)) first)]
+                   (do
+                     (prn metabadge)
+                     metabadge)
+                   (dissoc (get-badge-data ctx badge) :language :alt_language :tags :id))
+                 (if-let [required-badge (->> (select-factory-metabadge-required {:metabadge_id metabadge_id :required_badge_id (:id badge)} (u/get-db ctx)) first)]
+                   required-badge
+                   (dissoc (get-badge-data ctx badge) :language :alt_language :tags :id))
+
+                 )))))
+
+(defn get-required-badges [ctx user_id metabadge_id user_badge_id]
+  (let [received-required-badges (->> (select-received-required-badges {:metabadge_id metabadge_id :user_id user_id} (u/get-db ctx))
+                                      (group-by :name)
+                                      (reduce-kv
+                                        (fn [r k v]
+                                          (conj r (if (empty? (rest v))
+                                                    (first v)
+                                                    (if (some #(= (str (:id %)) (str user_badge_id)) v)
+                                                      (->> (remove #(not (= (str user_badge_id) (str (:id %)))) v) first)
+                                                      (->> v (sort-by :issued_on <) first))))) [])
+                                      (sort-by :issued_on <))
+        not-received-required-badges (some->> (select-not-received-required-badges {:metabadge_id metabadge_id} (u/get-db ctx))
+                                              (remove (fn [badge] (some #(= (select-keys badge [:name]) (select-keys % [:name])) received-required-badges))))] ;todo compare with more than name
+    (assoc {} :required_badges ((comp flatten concat) received-required-badges not-received-required-badges)
+      :received-badge-count (count received-required-badges))))
+
+(defn expand-required-badges-db
+  "build required badges from db"
+  [ctx user_id user_badge_id coll]
+  (reduce (fn [r m]
+            (let [required-badges-map (get-required-badges ctx user_id (or (:metabadge_id m) (:id m) ) user_badge_id) ]
+              (conj r (assoc m :required_badges (->> required-badges-map :required_badges)
+                        :completion_status (%completed (:min_required m) (->> required-badges-map :received-badge-count)))))) [] coll))
+
+(defn expand-required-badges [ctx metabadge_id badges assertion-url]
+  (->> badges (r/map #(lookup-badge ctx metabadge_id nil %)) (r/foldcat)))

 (defn- process-metabadge [ctx metabadge assertion-url]
   (->> (:metabadge metabadge)
-       (r/map (fn [m] (-> m
-                          (assoc :required_badges (expand-required-badges ctx (:required_badges m) assertion-url)
-                            :milestone? (= assertion-url (get-in m [:badge :url])))
-                          (update-in [:badge] merge (dissoc (get-badge-data ctx (:badge m)) :language :alt_language :tags :id)))))
-       (r/foldcat)
-       (assoc metabadge :metabadge)))
+       (r/map (fn [m]
+                (let [required-badges (expand-required-badges ctx (:id m) (:required_badges m) assertion-url)
+                      received-required-badges (filter :received required-badges)]
+                  (-> m
+                      (merge (lookup-badge ctx (:id m) "milestone" (:badge m)))
+                      (assoc :required_badges required-badges
+                        :completion_status (%completed (:min_required m) (count received-required-badges))
+                        :milestone? (= assertion-url (get-in m [:badge :url])))
+                      (dissoc :badge)))))
+       (r/foldcat)))

 (defn check-metabadge [ctx assertion-url]
   (let [meta-data-url (str (get-in ctx [:config :factory :url]) "/v1/assertion/metabadge/?url=" (u/url-encode assertion-url))]
-
     (if-let [check (string/starts-with? assertion-url (get-in ctx [:config :factory :url]))]
       (try
         (if-let [metabadge (fetch-json-data meta-data-url)]
           (let [processed-metabadge (process-metabadge ctx  metabadge assertion-url)]
-            (if (empty? (:metabadge processed-metabadge)) nil processed-metabadge))
+            (if (empty? processed-metabadge) nil (->>  processed-metabadge
+                                                       (group-by :milestone?)
+                                                       (reduce-kv (fn [r k v]
+                                                                    (if (true? k)
+                                                                      (assoc r :milestones v )(assoc r :required-in v))
+                                                                    ){}))))
           nil)
         (catch Exception e
           (log/error (str "Did not get metabadge information: " assertion-url))
@@ -103,61 +151,54 @@
           nil))
       nil)))

-(defn quick-check-metabadge
-  "check if badge is metabadge without processing"
-  [ctx assertion-url]
-  (let [meta-data-url (str (get-in ctx [:config :factory :url]) "/v1/assertion/metabadge/?url=" (u/url-encode assertion-url))]
-    (prn meta-data-url)
-    (if-let [metabadge (fetch-json-data meta-data-url)]
-      (if (empty? metabadge)
-        {}
-        (r/reduce (fn [r m]
-                    (conj r (-> m (assoc :milestone? (= assertion-url (get-in m [:badge :url])))) )) [] (:metabadge metabadge)))
-
-      {})))
-
-
-(defn milestone? [ctx user-id user_badge_id]
-  "check if badge is a milestone badge or a required badge. If both (= required_badge)"
-  (let [assertion-url (:assertion_url (b/get-badge ctx user_badge_id user-id))]
-    (when-not (clojure.string/blank? assertion-url)
-      (if-let [check (string/starts-with? assertion-url (get-in ctx [:config :factory :url]))]
-        (let [metabadge (quick-check-metabadge ctx assertion-url)]
-          (if-not (empty? metabadge)
-            (if (some false? (keys (group-by :milestone? metabadge))) {:required_badge true} {:milestone true})))
-        {}))))
-
-(defn get-user-badge-data [ctx user-id user_badge_id]
-  (let [key user_badge_id]
-    (cache/lookup (swap! user-badge-cache-storage
-                         #(if (cache/has? % key)
-                            (cache/hit % key)
-                            (cache/miss % key (milestone? ctx user-id user_badge_id)))) key)))
-
-
-#_(defn all-metabadges
-  "build metabadges from user badges"
-  [ctx user]
-  (let [obf-url (get-in ctx [:config :factory :url])
-        all-badges (filter (fn [b] (if-not (:assertion_url b) false (-> b :assertion_url (string/starts-with? obf-url)) ))(b/user-badges-all ctx (:id user)))
-        metabadges (r/reduce (fn [r m ]
-                               (if-let [check (string/starts-with? (:assertion_url m) obf-url)]
-                                 (conj r  (check-metabadge ctx (:assertion_url m)))
-                                 )) [] all-badges)]
-
-    (reduce-kv
-      (fn [r k v] (distinct-by :id (into [] (r/flatten
-                                              (conj r  (->> v
-                                                            :metabadge
-                                                            (map (fn [m]
-                                                                   (let [amount_received (count (filter :received (-> m :required_badges)))]
-                                                                     (assoc m :completion_status (%completed (-> m :min_required ) amount_received)))))))))))
-      []
-      metabadges)))
-
-
-(defn all-metabadges [ctx user]
-  (db/all-metabadges ctx (:id user))
-  )
-
-
+(defn metabadge->badge-map [ctx badge-id]
+  (some-> (select-received-metabadge-by-badge-id {:id badge-id} (u/get-db ctx)) first))
+
+(defn pending-metabadge? [ctx pending-assertion id]
+  (if-let [is-metabadge? (db/metabadge?! (:connection (u/get-db ctx)) (get-in ctx [:config :factory :url]) (-> pending-assertion (assoc :id id)))]
+    (let [badge (metabadge->badge-map ctx id)]
+      (db/get-metabadge! ctx (:connection (u/get-db ctx)) (get-in ctx [:config :factory :url]) badge))))
+
+
+(defn completed-metabadges [ctx user_id]
+  (let [metabadges (select-completed-metabadges {:user_id user_id} (u/get-db ctx))]
+    (->> metabadges (expand-required-badges-db ctx user_id nil))))
+
+(defn metabadges-in-progress [ctx user_id]
+  (let [metabadges (->> (select-all-user-metabadges {:user_id user_id} (u/get-db ctx)) (expand-required-badges-db ctx user_id nil))
+        completed-metabadges (completed-metabadges ctx user_id)]
+    (remove (fn [m] (some #(= (:metabadge_id %) (:id m)) completed-metabadges)) metabadges)))
+
+(defn all-metabadges [ctx user_id]
+  {:in_progress (metabadges-in-progress ctx user_id)
+   :completed (completed-metabadges ctx user_id)})
+
+(defn is-metabadge? [ctx user_badge_id]
+  (let [x (some-> (select-metabadge-info-from-user-badge {:id user_badge_id} (u/get-db ctx)) first)]
+    (reduce-kv (fn [r k v]
+                 (assoc r k (if (clojure.string/blank? v) false true))) {} x)))
+
+(defn is-received-metabadge? [ctx user_id metabadge_id]
+  (let [check (select-user-received-metabadge-by-metabadge-id {:metabadge_id metabadge_id :user_id user_id} (u/get-db ctx))]
+    (if (empty? check) false true)))
+
+(defn metabadge-helper [ctx user_badge_id user_id metabadge_ids]
+  (reduce (fn [r id]
+            (conj r
+                  (if-let [received-metabadge? (is-received-metabadge? ctx user_id id)]
+                    (->> (select-completed-metabadge-by-metabadge-id {:user_id user_id :metabadge_id id} (u/get-db ctx)) (expand-required-badges-db ctx user_id user_badge_id))
+                    (->> (select-factory-metabadge {:id id} (u/get-db ctx)) (expand-required-badges-db ctx user_id user_badge_id))))) [] metabadge_ids))
+
+(defn get-metabadge [ctx user_badge_id user_id]
+  (if-let [check (empty? (is-metabadge? ctx user_badge_id))]
+    {}
+    (let [user_id (if (nil? user_id) (some-> (select-user-id-by-user-badge-id {:id user_badge_id} (u/get-db ctx)) first :user_id) user_id)
+          milestones (->> (select-completed-metabadge-by-badge-id {:user_id user_id :user_badge_id user_badge_id} (u/get-db ctx)) (expand-required-badges-db ctx user_id nil))
+          required-in (->> (select-required-metatabadge-by-badge-id {:id user_badge_id} (u/get-db ctx))
+                           (map :metabadge_id)
+                           (metabadge-helper ctx user_badge_id user_id)
+                           flatten)]
+      {:milestones milestones :required-in required-in})))
+
+
+