lein-release plugin: preparing 0.4.12 release

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.4.11"
+(defproject re-view "0.4.12"
   :description "ClojureScript React Library"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


Day 3 part 2

Day 3 part 2

--- src/advent_2018/day_03.cljc
+++ src/advent_2018/day_03.cljc
@@ -13,18 +13,30 @@
 (def claims (map read-claim input-lines))

 (defn locs [claim]
-  (for [row (range (:top claim) (+ (:top claim) (:height claim)))
+  (for [row (range (:top claim)  (+ (:top claim)  (:height claim)))
         col (range (:left claim) (+ (:left claim) (:width claim)))]
     [row col]))

 (defn add-claim [fabric claim]
   (reduce
     (fn [fabric loc]
-      (update fabric loc (fnil inc 0)))
+      (update fabric loc conj (:id claim)))
     fabric
     (locs claim)))

+(defn loc->claims-ids [claims]
+  (reduce add-claim {} claims))
+
+(defn overlapping? [loc-claims]
+  (> (count loc-claims) 1))
+
+(defn overlapping-loc-claims [claims]
+  (filter overlapping? (vals (loc->claims-ids claims))))
+
 (defn part-1 []
-  (let [fabric-counts (reduce add-claim {} claims)
-        overlapping-counts (filter #(> (val %) 1) fabric-counts)]
-    (count overlapping-counts)))
+  (count (overlapping-loc-claims claims)))
+
+(defn part-2 []
+  (let [overlapping-claim-ids (reduce into #{} (overlapping-loc-claims claims))
+        all-claim-ids         (map :id claims)]
+    (first (remove overlapping-claim-ids all-claim-ids))))


semantics for :dance, :enter, :faint, :say

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -296,6 +296,9 @@
          :subj {:human true}
          :obj {:human true}}

+        {:pred :dance
+         :subj {:human true}}
+
         {:pred :deludere
          :obj {:human true}}

@@ -307,9 +310,16 @@
          :subj {:human true}
          :obj {:human false}}

+        {:pred :enter
+         :subj {:animate true}
+         :obj {:place true}}
+
         {:pred :exit
          :subj {:animate true}}

+        {:pred :faint
+         :subj {:animate true}}
+
         {:pred :fall-asleep
          :subj {:animate true}}

@@ -384,6 +394,10 @@
         {:pred :read
          :subj {:human true}
          :obj {:legible true}}
+
+        {:pred :say
+         :subj {:human true}
+         :obj {:speakable true}}

         {:pred :scold
          :subj {:human true}}


cleaning up ns declaration

cleaning up ns declaration

--- src/examples/core.cljs
+++ src/examples/core.cljs
@@ -12,8 +12,7 @@
                           runner-start
                           runner-stop]]
    [frontier.example.components :refer [ExampleTodos ExampleCounter]]
-   [frontier.cards :as cards :refer [managed-system-card
-                                     system-card
+   [frontier.cards :as cards :refer [system-card
                                      input-controls-renderer
                                      managed-history-card]]
    [reactor.core :refer [render-to] :as rct]


get-text now uses multiple bodies instead of if

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

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

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


remove addressed TODO comment

remove addressed TODO comment

--- src/braid/server/schema.clj
+++ src/braid/server/schema.clj
@@ -48,7 +48,6 @@
   :db/id #db/id [:db.part/db]
   :db.install/_attribute :db.part/db}
  ; user - preferences
- ; TODO: make preferences entities, instead of string
  {:db/ident :user/preferences
   :db/valueType :db.type/ref
   :db/cardinality :db.cardinality/many


fix attempt #1

fix attempt #1

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -189,7 +189,7 @@
         (let [sound-id (first (get (:sound-ids @app-state) track-id))]
           (swap! app-state assoc :sound-ids
             (merge (:sound-ids @app-state)
-                   {track-id (vec (remove #(= sound-id %) (get (:sound-ids @app-state) track-id)))}))
+                   {track-id (vec (drop 1 (get (:sound-ids @app-state) track-id)))}))

           (swap! app-state assoc :current-sound
             (.createSound js/soundManager #js {:id sound-id


optimize repaint by narrowing the state passed to sub components

--- src/chessground/render.cljs
+++ src/chessground/render.cljs
@@ -14,32 +14,37 @@
 (q/defcomponent Piece
   "A piece in a square"
   [[{color :color role :role} targets] channels]
+  ; (pp "render piece")
   (let [piece (d/div {:className (class-name #{"piece" (name color) (name role)})})]
     (if targets (drag/make channels piece targets) piece)))

 (q/defcomponent Square
   "One of the 64 board squares"
-  [state key channels]
+  [{selected :selected movable :movable chess :chess} key channels]
+  ; (pp (str "render square " key))
   (let [attributes {:className (class-name #{"square"
-                                             (when (= (:selected state) key) "selected")})
+                                             (when selected "selected")})
                     :key (name key) ; react.js key just in case it helps performance
                     :data-key (name key)}
-        targets (if (-> state :movable :free) :all (-> state :movable :valid key))
+        targets (if (:free movable) :all (-> movable :valid key))
         behaviors (when targets {:onClick #(push! (:select-square channels) key)
                                  :onTouchStart (fn [event]
                                                  (.preventDefault event)
                                                  (push! (:select-square channels) key))})]
     (d/div (merge attributes behaviors)
-           (when-let [piece (chess/get-piece (:chess state) key)]
+           (when-let [piece (chess/get-piece chess key)]
              (Piece [piece targets] channels)))))

 (q/defcomponent Board
   "The whole board"
   [state channels]
+  ; (pp "render board")
   (let [white (= (:orientation state) :white)
         squares (for [rank (if white (range 8 0 -1) (range 1 9))
                       file (seq (if white "abcdefgh" "hgfedcba"))]
-                  (Square state (keyword (str file rank)) channels))]
+                  (Square {:selected (= (:selected state) key)
+                           :movable (:movable state)
+                           :chess (:chess state)} (keyword (str file rank)) channels))]
     (apply d/div {:className "board"} squares)))

 (q/defcomponent App


add player colors to chat

add player colors to chat

--- src/client/pages/lobby.cljs
+++ src/client/pages/lobby.cljs
@@ -34,21 +34,21 @@
 (hiccups/defhtml chat-msg-html
   [{:keys [user color msg]}]
   [:div.message-6ab4b
-    [:div.user-eb71d (hiccups.runtime/escape-html user)]
+    [:div {:class (str "color-" color " user-eb71d")} (hiccups.runtime/escape-html user)]
     [:div.text-d43c1 (hiccups.runtime/escape-html msg)]])

 (hiccups/defhtml chat-join-html
   [{:keys [user color]}]
   [:div.message-6ab4b
-    [:div.joined-3a6ea (str user " joined the lobby")]])
+    [:div {:class (str "color-" color)} (str user " joined the lobby")]])

 (hiccups/defhtml chat-leave-html
   [{:keys [user color]}]
   [:div.message-6ab4b
-    [:div.left-bcb89 (str user " left the lobby")]])
+    [:div {:class (str "color-" color)} (str user " left the lobby")]])

 (hiccups/defhtml player-name [p]
-  [:div.player-name-f93cf (:user p)])
+  [:div {:class (str "color-" (:color p) " player-name-f93cf")}(:user p)])

 (hiccups/defhtml player-list [players]
   (map player-name players))


use job/user arg if present

use job/user arg if present

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -986,7 +986,9 @@
 (defn job-name-template
   [tpl args]
   (-> tpl
-      (str/replace #"%U" (or (System/getProperty "user.name") "nemo"))
+      (str/replace #"%U" (or (System/getProperty "user.name")
+                             (:user (:job args))
+                             "nemo"))
       (str/replace #"%A" *pipeline-builder-caller*)
       (str/replace #"%T" (create-timestamp))
       (str/lower-case)


Fix spec

Fix spec

--- src/clj/nightcode/state.clj
+++ src/clj/nightcode/state.clj
@@ -66,5 +66,5 @@
 (fdef read-pref
   :args (s/alt
           :key-only (s/cat :key keyword?)
-          :key-and-val (s/cat :key keyword? :default-val identity)))
+          :key-and-val (s/cat :key keyword? :default-val any?)))


categories and movements showing correctly, edit-refresh-delete-add works.

--- src/cljs/movement/core.cljs
+++ src/cljs/movement/core.cljs
@@ -40,54 +40,39 @@
 (defn prep-name [kw]
   (str/replace (str/capitalize (name kw)) "-" " "))

-(defn refresh-button [part]
-  [:div.one.column
-   {:type     "button"
-    :class    "button"
-    :on-click #(generate! (:name part) (:category part) 1)}
-   "#"])
-
-(defn list-movements [part]
-  (for [movement (:movements part)]
-    [:div.row
-     [:div.six.columns {:draggable true} (prep-name movement)]
-     (refresh-button part)]))
-
-(defn update! [button]
+(defn set-button-selected! [button]
   (do
-    (reset! ttemplate [])
     (reset! buttons default-buttons)
     (button-selected! button)))

-(defonce movements (atom (sorted-map)))
-(defonce template (atom (sorted-map)))
+(defonce session (atom {}))
+(swap! session assoc :categories (sorted-map))
+(swap! session assoc :movements (sorted-map))
+
 (defonce m-counter (atom 0))
 (defonce c-counter (atom 0))

-(defn add-movement! [text category-id]
-  (let [category (get @template category-id)
-        id (swap! (:m-counter category) inc)]
-    (swap! (:movements category) assoc id {:id id :title text})))
-
 (defn add-category! [title category]
   (let [id (swap! c-counter inc)]
-    (swap! template assoc id {:id id :title title
-                              :category category :m-counter (atom 0)
-                              :movements (atom (sorted-map))})))
-
-(defn add-mmovement! [text]
+    (swap! session assoc-in [:categories id] {:id id :title title :category category})))
+
+(defn add-movement! [text category-id]
   (let [id (swap! m-counter inc)]
-    (swap! movements assoc id {:id id :title text :done false})))
-
-(defn update-category! [id title] (swap! template assoc-in [id :title] title))
-(defn delete-category! [id] (swap! template dissoc id))
-
-(defn update-movement! [id title] (swap! movements assoc-in [id :title] title))
-(defn delete-movement! [id] (swap! movements dissoc id))
-
-(defn refresh-movement! [id] (update-movement! id (prep-name (first (take 1 (shuffle strength))))))
-
-(defn mmap [m f a] (->> m (f a) (into (empty m))))
+    (swap! session assoc-in [:movements id] {:id id :title text :category-ref category-id})))
+
+(defn update! [kw id title] (swap! session assoc-in [kw id :title] title))
+
+(defn delete! [kw id] (swap! session update-in [kw] dissoc id))
+
+(defn refresh! [id category] (update! :movements id (prep-name (first (take 1 (shuffle category))))))
+
+(defn reset-session! []
+  (do
+    (reset! session {})
+    (swap! session assoc :categories (sorted-map))
+    (swap! session assoc :movements (sorted-map))
+    (reset! c-counter 0)
+    (reset! m-counter 0)))

 (defn movement-input [{:keys [title on-save on-stop]}]
   (let [val (atom title)
@@ -110,36 +95,27 @@

 (defn movement-item []
   (let [editing (atom false)]
-    (fn [{:keys [id done title]}]
-      [:li {:class (str (if done "completed ")
-                        (if @editing "editing"))}
-       [:div.view
-        [:label {:on-double-click #(reset! editing true)} title]
-        [:button.button.button-primary {:on-click #(refresh-movement! id)}]
-        [:button.destroy {:on-click #(delete-movement! id)}]]
+    (fn [{:keys [id title category-ref]}]
+      [:div.row {:class (str (if @editing "editing"))}
+       [:label.three.columns {:on-double-click #(reset! editing true)} title]
+       [:button.one.column.button.button-primary
+        {:on-click #(refresh! id (:category (get (:categories @session) category-ref)))}]
+       [:button.one.column.destroy {:on-click #(delete! :movements id)}]
        (when @editing
-         [movement-edit {:class "edit" :title title
-                         :on-save #(update-movement! id %)
+         [movement-edit {:class   "edit" :title title
+                         :on-save #(update! :movements id %)
                          :on-stop #(reset! editing false)}])])))

 (defn category-item []
-  (fn [{:keys [id category title movements]}]
+  (fn [{:keys [id category title]} movements]
     [:div
-     [:label title]
-     (let [items (vals @movements)]
-       [:p (str items)]
-       (when (-> items count pos?)
-         [:div
-          [:section
-           [:ul
-            [:li "!!"]
-            #_(for [movement items]
-              ^{:key (:id movement)} [movement-item movement])]]])
-       [movement-input {:id          "new-movement"
-                        :placeholder "Add movement.."
-                        :on-save     #(add-movement! %1 id)}])]))
-
-(print @template)
+     [:h3 title]
+     (when (-> movements count pos?)
+       (for [m movements]
+         ^{:key (:id m)} [movement-item m]))
+     [movement-input {:id          "new-movement"
+                      :placeholder "Add movement.."
+                      :on-save     #(add-movement! %1 id)}]]))

 (defn home-page []
   [:div
@@ -152,112 +128,141 @@
        {:type     "button"
         :class    (:ritual @buttons)
         :on-click #(do
-                    (update! :ritual)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 5)
-                    (generate! "Hanging" hanging 1)
-                    (generate! "Equilibre" equilibre 1)
-                    (generate! "Strength" strength 1))}
+                    (reset-session!)
+                    (set-button-selected! :ritual)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 5] (add-movement! (prep-name (nth (take 5 (shuffle mobility)) n)) 2))
+                    (add-category! "Hanging" hanging)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle hanging)) n)) 3))
+                    (add-category! "Equilibre" equilibre)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle equilibre)) n)) 4))
+                    (add-category! "Strength" strength)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle strength)) n)) 5)))}
        "Morning ritual"]
       [:div.three.columns
        {:type     "button"
         :class    (:strength @buttons)
-        :on-click #(let [wu-n 1
-                         mob-n 6
-                         st-n 4
-                         wu (take wu-n (shuffle warmup))
-                         mob (take mob-n (shuffle mobility))
-                         st (take st-n (shuffle strength))]
-                    (reset! template (sorted-map))
-                    (reset! c-counter 0)
-                    (add-category! "Warmup" warmup)
-                    (add-movement! "Push up" 1)
-                    #_(dotimes [n wu-n] (add-movement! (prep-name (nth wu n)) (ffirst @template)))
-                    (add-category! "Mobility" warmup)
-                    #_(dotimes [n mob-n] (add-movement! (prep-name (nth mob n)) (second @template)))
+        :on-click #(do
+                    (reset-session!)
+                    (set-button-selected! :strength)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
                     (add-category! "Strength" strength)
-                    #_(dotimes [n st-n] (add-movement! (prep-name (nth st n)) (nth @template 2)))
-
-                    #_(update! :strength)
-                    #_(generate! "Warmup" warmup 1)
-                    #_(generate! "Mobility" mobility 5)
-                    #_(generate! "Strength" strength 4))}
+                    (dotimes [n 4] (add-movement! (prep-name (nth (take 4 (shuffle strength)) n)) 3)))
+        }
        "Strength"]
       [:div.three.columns
        {:type     "button"
         :class    (:mobility @buttons)
         :on-click #(do
-                    (update! :mobility)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 8)
-                    (generate! "Prehab" mobility 4))}
+                    (reset-session!)
+                    (set-button-selected! :mobility)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
+                    (add-category! "Prehab" mobility)
+                    (dotimes [n 4] (add-movement! (prep-name (nth (take 4 (shuffle mobility)) n)) 3)))}
        "Mobility/Prehab"]
       [:div.three.columns
        {:type     "button"
         :class    (:locomotion @buttons)
         :on-click #(do
-                    (update! :locomotion)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 6)
-                    (generate! "Locomotion" locomotion 6))}
+                    (reset-session!)
+                    (set-button-selected! :locomotion)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
+                    (add-category! "Locomotion" locomotion)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle locomotion)) n)) 3)))}
        "Locomotion"]]
      [:div.row
       [:div.three.columns
        {:type     "button"
         :class    (:bas @buttons)
         :on-click #(do
-                    (update! :bas)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 6)
-                    (generate! "Bent Arm Strength" bas 5))}
+                    (reset-session!)
+                    (set-button-selected! :bas)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
+                    (add-category! "Bent Arm Strength" bas)
+                    (dotimes [n 5] (add-movement! (prep-name (nth (take 5 (shuffle bas)) n)) 3)))}
        "BAS"]
       [:div.three.columns
        {:type     "button"
         :class    (:sass @buttons)
         :on-click #(do
-                    (update! :sass)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 6)
-                    (generate! "Straight Arm Scapular Strength" sass 4))}
+                    (reset-session!)
+                    (set-button-selected! :sass)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
+                    (add-category! "Straight Arm Scapular Strength" sass)
+                    (dotimes [n 4] (add-movement! (prep-name (nth (take 4 (shuffle sass)) n)) 3)))}
        "SASS"]
       [:div.three.columns
        {:type     "button"
         :class    (:leg @buttons)
         :on-click #(do
-                    (update! :leg)
-                    (generate! "Warmup" warmup 1)
-                    (generate! "Mobility" mobility 6)
-                    (generate! "Leg Strength" leg-strength 3)
-                    (generate! "Auxiliary" auxiliary 2))}
+                    (reset-session!)
+                    (set-button-selected! :leg)
+                    (add-category! "Warmup" warmup)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle warmup)) n)) 1))
+                    (add-category! "Mobility" mobility)
+                    (dotimes [n 6] (add-movement! (prep-name (nth (take 6 (shuffle mobility)) n)) 2))
+                    (add-category! "Leg Strength" leg-strength)
+                    (dotimes [n 3] (add-movement! (prep-name (nth (take 3 (shuffle leg-strength)) n)) 3))
+                    (add-category! "Auxiliary" auxiliary)
+                    (dotimes [n 2] (add-movement! (prep-name (nth (take 2 (shuffle auxiliary)) n)) 4)))}
        "Leg strength"]
       [:div.three.columns
        {:type     "button"
         :class    (:movnat @buttons)
         :on-click #(do
-                    (update! :movnat)
-                    (generate! "Warmup Mobility (3 rounds)" movnat-warmup 3)
-                    (generate! "Skill (30 reps)" movnat 1)
-                    (generate! "Combo (4 rounds)" movnat 4))}
+                    (reset-session!)
+                    (set-button-selected! :movnat)
+                    (add-category! "Warmup Mobility (3 rounds)" movnat-warmup)
+                    (dotimes [n 3] (add-movement! (prep-name (nth (take 3 (shuffle movnat-warmup)) n)) 1))
+                    (add-category! "Skill (30 reps)" movnat)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle movnat)) n)) 2))
+                    (add-category! "Combo (4 rounds)" movnat)
+                    (dotimes [n 4] (add-movement! (prep-name (nth (take 4 (shuffle movnat)) n)) 3)))}
        "MovNat"]]
      [:div.row
       [:div.three.columns
        {:type     "button"
         :class    (:maya @buttons)
         :on-click #(do
-                    (update! :maya)
-                    (generate! "Oppvarming/Bevegelighet (2 runder rolig)" m-oppvarming 3)
-                    (generate! "Styrke/Ferdighet (30 reps)" m-styrke 1)
-                    (generate! "Kombinasjon (3 runder hurtig)" m-kombinasjon 4))}
+                    (reset-session!)
+                    (set-button-selected! :maya)
+                    (add-category! "Oppvarming/Bevegelighet (2 runder rolig)" m-oppvarming)
+                    (dotimes [n 3] (add-movement! (prep-name (nth (take 3 (shuffle m-oppvarming)) n)) 1))
+                    (add-category! "Styrke/Ferdighet (30 reps)" m-styrke)
+                    (dotimes [n 1] (add-movement! (prep-name (nth (take 1 (shuffle m-styrke)) n)) 2))
+                    (add-category! "Kombinasjon (3 runder hurtig)" m-kombinasjon)
+                    (dotimes [n 4] (add-movement! (prep-name (nth (take 4 (shuffle m-kombinasjon)) n)) 3)))}
        "Maya"]]]]
-   [:div {:class "section movements"}
+   [:div.section.movements
     [:div.container
-     (let [categories (vals @template)]
-       [:section
-        (when (-> categories count pos?)
-          [:div
-           (for [c categories]
-             ^{:key (:id c)} [category-item c])])])
-     ]]
+     (let [session @session
+           categories (vals (:categories session))
+           movements (vals (:movements session))]
+       (when (-> categories count pos?)
+         [:div.row
+          (for [c categories]
+            ^{:key (:id c)} [category-item
+                             c
+                             (filter
+                               #(= (:id c) (:category-ref %))
+                               movements)])]))]]
    [:div.footer
     [:div.container
      [:em "If you have suggestions for a new session template, some sorely missing movements


Factorization

Factorization

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -233,13 +233,12 @@

 (defn show-top-panel
   [scores player]
-  (into
-    [:div.scores]
-    (concat
-      [[top-panel-button #(swap! app-state update :help not) (special-char "↻")]]
-      (show-scores scores player)
-      [[top-panel-button #(swap! app-state update :help not) "?"]]
-      )))
+  [:div.scores
+   (concat
+     [[top-panel-button #(swap! app-state update :help not) (special-char "↻")]]
+     (show-scores scores player)
+     [[top-panel-button #(swap! app-state update :help not) "?"]]
+     )])

 (defn run-game []
   [:div


Comments

Comments


renaming

renaming

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -10,7 +10,7 @@
 ;; (enable-console-print!)
 ;; (set! *assert* false)

-(defn run-game []
+(defn triboard []
   (frame/main-frame @store/current-turn @store/suggestions
     (reify view/IUserInteractions
       (on-new-game [_] (loop/sent-menu-event! [:new-game]))
@@ -20,5 +20,5 @@
       (on-player-move [_ x y] (loop/send-game-event! [x y]))
       )))

-(reagent/render [run-game]
+(reagent/render [triboard]
   (js/document.getElementById "app"))


Send asset response with far-future expires header Add content length to response Identify invalid checksum and send a 301 response

--- src/io/aviso/twixt.clj
+++ src/io/aviso/twixt.clj
@@ -1,5 +1,6 @@
 (ns io.aviso.twixt
   "Pipeline for accessing and transforming assets for streaming. Integrates with Ring."
+  (:import [java.util Calendar TimeZone])
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
             [clojure.tools.logging :as l]
@@ -157,27 +158,53 @@
     [(.substring suffix 0 slashx)
      (.substring suffix (inc slashx))]))

+(def ^:private far-future (-> (doto (Calendar/getInstance (TimeZone/getTimeZone "UTC"))
+                                (.add Calendar/YEAR 10))
+                              .getTime))
+
+(defn- asset->ring-response
+  [asset]
+  (-> asset
+      :content
+      io/input-stream
+      r/response
+      (r/header "Content-Length" (:size asset))
+      ;; Because any change to the content will create a new checksum and a new URL, a change to the content
+      ;; is really an entirely new resource. The current resource is therefore immutable and can have a far-future expires
+      ;; header.
+      (r/header "Expires" far-future)
+      (r/content-type (:content-type asset))))
+
+(defn- asset->301-response
+  [path-prefix asset]
+  {
+    :status  301
+    :headers {"Location" (asset/asset->request-path path-prefix asset)}
+    :body    ""})
+
+(defn- create-asset-response
+  [path-prefix requested-checksum asset]
+  (cond
+    (nil? asset) nil
+    (= requested-checksum (:checksum asset)) (asset->ring-response asset)
+    :else (asset->301-response path-prefix asset)))
+
 (defn twixt-handler
   "A Ring request handler that identifies requests targetted for Twixt assets.  Returns a Ring response map
-  if the request is for an existing asset, otherwise returns nil."
+  if the request is for an existing asset, otherwise returns nil.
+
+  Asset URLs always include the intended asset's checksum; if the actual asset checksum does not match, then
+  a 301 (moved permanently) response is sent with the correct asset URL."
   [request]
   (let [path-prefix (-> request :twixt :path-prefix)
         path (:uri request)]
     (when (match? path-prefix path)
       (tracker/trace
         #(format "Handling asset request `%s'." path)
-        (let [[request-checksum asset-path] (parse-path path-prefix path)
+        (let [[requested-checksum asset-path] (parse-path path-prefix path)
               twixt (:twixt request)
               asset-pipeline (:asset-pipeline twixt)]
-          (if-let [asset-map (asset-pipeline asset-path twixt)]
-            (-> asset-map
-                :content
-                io/input-stream
-                r/response
-                ;; TODO: more headers, including ETags
-                (r/content-type (:content-type asset-map)))
-            ;; else - TODO, only if path-prefix is not ""
-            (l/warnf "Asset path `%s' in request does not match an available file." path)))))))
+          (create-asset-response path-prefix requested-checksum (asset-pipeline asset-path twixt)))))))

 (defn wrap-with-twixt
   "Invokes the twixt-handler and delegates to the provided handler if twixt-handler returns nil.


[TEMP COMMIT] Converting new removal functions to use new `Timetable` data structure

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -675,8 +675,8 @@
          lessonInfoSeq)))

 (defn- get-largest-consecutive-time-slot-freed-up-by-lesson
-  "Given a removed lessonInfo, find the largest interval which is freed up due
-   to the its removal.
+  "Given a removed lesson, find the largest interval on the same row which is
+   freed up due to the its removal.

    For instance, given this timetable row:

@@ -687,129 +687,145 @@
    2 empty slots to its right will be freed up.

    Given that the first slot occupied by the label 'x' is the index 0, this
-   function will return the vector [3 11]."
-  [removedLessonInfo]
-  (let [day        (:day removedLessonInfo)
-        row        (:rowNum removedLessonInfo)
-        startTime  (:startTime removedLessonInfo)
-        endTime    (:endTime removedLessonInfo)
+   function will return the vector [3 11].
+
+   The parameter `removedAugTTLessonInfo` is a `TimetableLessonInfo` object
+   augmented with the `:day` and `:rowNum` keys."
+  [removedAugTTLessonInfo]
+  (let [day        (:day removedAugTTLessonInfo)
+        row        (:rowNum removedAugTTLessonInfo)
+        startTime  (:startTime removedAugTTLessonInfo)
+        endTime    (:endTime removedAugTTLessonInfo)
         ttRow      (get-in Timetable [day row])
         minTimeIdx (time-helper/TIME-INDEX-MIN)
         maxTimeIdx (time-helper/TIME-INDEX-MAX)]

     [
-      ; Find the minimum timeslot that's free
-      (loop [timeIdx     (dec startTime)
-             occupiedVec (:occupied ttRow)]
-        (cond (< timeIdx minTimeIdx)           minTimeIdx
-              (nil? (nth occupiedVec timeIdx)) (recur (dec timeIdx) occupiedVec)
-              :else                            (inc timeIdx)))
-
-      ; Find the maximum timeslot that's free
-      (loop [timeIdx     (inc endTime)
-             occupiedVec (:occupied ttRow)]
-        (cond (> timeIdx maxTimeIdx)          maxTimeIdx
-              (nil? (nth occupiedVec timeIdx) (recur (inc timeIdx) occupiedVec))
-              :else                           (dec timeIdx)))
+      ; Find the lesson right before the removed lesson
+      (let [immediateTTLessonInfoBefore
+            (reduce (fn [ttLessonInfoBefore [ttLessonInfo _]]
+                      (let [stime (:startTime ttLessonInfo)
+                            etime (:endTime ttLessonInfo)]
+                        (cond (and (nil? ttLessonInfoBefore)
+                                   (<= etime startTime))
+                              ttLessonInfo
+
+                              (and (not (nil? ttLessonInfoBefore))
+                                   (<= etime startTime)
+                                   (> etime (:endTime ttLessonInfoBefore)))
+                              ttLessonInfo
+
+                              :else ttLessonInfoBefore)))
+                    nil
+                    ttRow)]
+        (if (nil? immediateTTLessonInfoBefore)
+            minTimeIdx
+            (:endTime immediateTTLessonInfoBefore)))
+
+      ; Find the lesson right after the removed lesson
+      (let [immediateTTLessonInfoAfter
+            (reduce (fn [ttLessonInfoAfter [ttLessonInfo _]]
+                      (let [stime (:startTime ttLessonInfo)
+                            etime (:endTime ttLessonInfo)]
+                        (cond (and (nil? ttLessonInfoAfter)
+                                   (>= stime endTime))
+                              ttLessonInfo
+
+                              (and (not (nil? ttLessonInfoAfter))
+                                   (>= stime endTime)
+                                   (< stime (:endTime ttLessonInfoAfter)))
+
+                              :else ttLessonInfoAfter)))
+                    nil
+                    ttRow)]
+        (if (nil? immediateTTLessonInfoAfter)
+            maxTimeIdx
+            (dec (:startTime immediateTTLessonInfoAfter))))
     ]))

 (defn- find-replacement-lessons-within-time
-  "Given a lessonInfo which has been removed, find other lessons
-   on the same day but in a row below the removed lesson, which could be shifted
-   upwards and take the timeslots freed up by the removed lesson."
-  [removedLessonInfo]
-  (let [day       (:day removedLessonInfo)
-        row       (:rowNum removedLessonInfo)
-        startTime (:startTime removedLessonInfo)
-        endTime   (:endTime removedLessonInfo)
+  "For a removed lesson, find other lessons on the same day but in a row below
+   the removed lesson which could be shifted upwards and take the timeslots
+   freed up by the removed lesson.
+
+   The `removedAugTTLessonInfo` parameter is an `TimetableLessonInfo` object
+   augmented with the `:day` and `:rowNum` keys.
+
+   Returns a map, where keys are `TimetableLessonInfo` objects augmented with
+   `:day` and `:rowNum` keys, and values are jQuery <div> objects for the
+   shifted lesson."
+  [removedAugTTLessonInfo]
+  (let [day        (:day removedAugTTLessonInfo)
+        rowNum     (:rowNum removedAugTTLessonInfo)
+        startTime  (:startTime removedAugTTLessonInfo)
+        endTime    (:endTime removedAugTTLessonInfo)
+        ModulesMap (aget js/window "ModulesMap")
+        dayRows    (get-in Timetable [day rowNum])

         ; This is the time range freed up by removal of the lesson
         [lowTimeIdx highTimeIdx]
         (get-largest-consecutive-time-slot-freed-up-by-lesson
-          removedLessonInfo)
-
-        ModulesMap (aget js/window "ModulesMap")]
-
-    (:lessonsToShiftUp
+          removedAugTTLessonInfo)
+
+        not-occupied?
+        (fn [occupiedVec startTime endTime]
+          (every? #(nil? %1)
+                  (map #(nth occupiedVec %1)
+                       (range startTime endTime))))]
+
+    (:augTTLessonInfoMapToShift
       (reduce
-        (fn [reduceResult ttRow]
-          (if (<= (:nrLessons ttRow) 0)
+        (fn [reduceResult [rowIdx ttRow]]
+          (if (empty? ttRow)
               ; Skip empty row
               reduceResult
+
               ; Non-empty row
-              (let [ttRowOccupied      (:occupied ttRow)
-                    currentOccupiedVec (:occupiedVec reduceResult)
-
-                    ; get any lessons overlapping with [lowTimeIdx, highTimeIdx]
-                    ttRowLessonsPartiallyInTimeRange
-                    (reduce (fn [lessonsSet lesson] (conj lessonsSet lesson))
-                            #{}
-                            ; get everything in [lowTimeIdx, highTimeIdx] and
-                            ; remove all `nil`
-                            (filter #(not (nil? %1))
-                                    (map #(nth ttRowOccupied %1)
-                                         (range lowTimeIdx (inc highTimeIdx)))))
-
-                    ; Filter those that are within the time range and can fit in
-                    ; and unoccupied time interval
-                    ttRowLessonsToShift
-                    (filter #(let [lesson
-                                   (get-in ModulesMap
-                                           [(:moduleCode %1) "lessons"
-                                            (:lessonType %1) (:lessonGroup %1)
-                                            (:index %1)])
-
-                                   lessonStart (:startTime lesson)
-                                   lessonEnd   (:endTime lesson)]
-                               (and
-                                 ; check that lesson is in time range
-                                 (>= lessonStart lowTimeIdx)
-                                 (<= (dec lessonEnd) highTimeIdx)
-                                 ; and is within an unoccupied interval
-                                 (every? #(nil? %1)
-                                         (map #(nth currentOccupiedVec %1)
-                                              (range lessonStart lessonEnd)))))
-                            ttRowLessonsPartiallyInTimeRange)]
-
-                {:lessonToShiftUp
-                 (reduce (fn [ttRowLessonsSet ttRowLesson]
-                           (conj ttRowLessonsSet ttRowLesson))
-                         (:lessonsToShiftUp reduceResult)
-                         ttRowLessonsToShift)
+              (let [occupiedVec (:occupiedVec reduceResult)
+
+                    ttLessonInfoToShift
+                    (filter (fn [[ttLessonInfo _]]
+                              (let [stime (:startTime ttLessonInfo)
+                                    etime (:endTime ttLessonInfo)]
+                                (and (>= stime lowTimeIdx)
+                                     (<= (dec etime) highTimeIdx)
+                                     (not-occupied? occupiedVec stime etime))))
+                            ttRow)]
+                {:augTTLessonInfoMapToShift
+                 (reduce (fn [augTTLessonInfoMap [ttLessonInfo $divElem]]
+                           (assoc augTTLessonInfoMap
+                                  (assoc ttLessonInfo :day day :rowNum :rowIdx)
+                                  $divElem))
+                         (:augTTLessonInfoMapToShift reduceResult)
+                         ttLessonInfoToShift)

                  :occupiedVec
-                 (reduce (fn [occupiedVec ttRowLesson]
-                           (reduce (fn [occVec timeIdx]
-                                     (assoc occVec timeIdx true))
-                                   occupiedVec
-                                   ; get time range of the lesson
-                                   (let [lesson
-                                         (get-in ModulesMap
-                                                 [(:moduleCode ttRowLesson)
-                                                  "lessons"
-                                                  (:lessonType ttRowLesson)
-                                                  (:lessonGroup ttRowLesson)
-                                                  (:index ttRowLesson)])]
-                                     (range (:startTime lesson)
-                                            (:endTime lesson)))))
-                         currentOccupiedVec
-                         ttRowLessonsToShift)})))
-        {:lessonsToShiftUp #{},
+                 (reduce (fn [occVec [ttLessonInfo _]]
+                           (reduce (fn [ov timeIdx] (assoc ov timeIdx true))
+                                   occVec
+                                   (range (:startTime ttLessonInfo)
+                                          (:endTime ttLessonInfo))))
+                         occupiedVec
+                         ttLessonInfoToShift)})))
+        {:augTTLessonInfoMapToShift {},
          ; nil = free slot, true = occupied slot
          :occupiedVec      [vec (map (fn [t] nil) (range 800 2400 50))]}
         ; go through each row in the day, below the current row
-        (drop (inc row) (get-timetable-day day))))))
-
+        (drop (inc rowNum) (map vector (range (count dayRows)) dayRows))))))
+
+; TODO: Implement this function
 (defn- shift-lesson-to-row
   "Shifts a lesson from its original row up to the given row."
   [ttRowLesson rowNum]
-  j
   )

 (defn- shift-lessons-upwards-to-replace-empty-slots
   "For each removed lesson, see if there are any lessons in rows below it that
-   can be shifted upwards to occupy the empty slots resulting from its removal."
-  [removedLessonInfoSeq]
+   can be shifted upwards to occupy the empty slots resulting from its removal.
+
+   The paramter `removedAugmentedTTLessonInfoSeq` is a sequence of
+   `TimetableLessonInfo` objects augmented with the `:day` and `:rowNum` keys."
+  [removedAugmentedTTLessonInfoSeq]
   (let [; we do not consider any lessons on empty rows for ease of
         ; implementation
         exclude-lessons-on-empty-rows
@@ -817,43 +833,45 @@
           (filter #(let [day   (:day %1)
                          row   (:rowNum %1)
                          ttRow (get-in Timetable [day row])]
-                     (not= (:nrLessons ttRow) 0))
+                     (not (empty? ttRow)))
                   lessonInfoSeq))

-        sort-lesson-info-seq (fn [lessonInfoSeq]
-                               (sort #(let [dayA (:day %1)
-                                            dayB (:day %2)]
-                                        (if (= dayA dayB)
-                                          (< (:rowNum %1) (:rowNum %2))
-                                          (< dayA dayB)))
-                                     lessonInfoSeq))]
-
-    (loop [currentLessonInfoSeq
+        sort-lesson-info-seq
+        (fn [lessonInfoSeq]
+          (sort #(let [dayA (:day %1)
+                       dayB (:day %2)]
+                   (if (= dayA dayB)
+                       (< (:rowNum %1) (:rowNum %2))
+                       (< dayA dayB)))
+                lessonInfoSeq))]
+
+    (loop [sortedAugTTLessonInfoSeq
            (sort-lesson-info-seq (exclude-lessons-on-empty-rows
-                                   removedLessonInfoSeq))
+                                   removedAugmentedTTLessonInfoSeq))

            nextLessonInfoVec    []]
-      (cond (and (empty? currentLessonInfoSeq) (empty? nextLessonInfoVec))
+      (cond (and (empty? sortedAugTTLessonInfoSeq) (empty? nextLessonInfoVec))
             nil

             ; we're done for the current set of lessons. Move on to the
             ; set of lessons that were shifted upwards.
-            (empty? currentLessonInfoSeq)
-            (recur
-              (sort-lesson-info-seq (exclude-lessons-on-empty-rows
-                                      nextLessonInfoVec))
-              [])
+            (empty? sortedAugTTLessonInfoSeq)
+            (recur (sort-lesson-info-seq (exclude-lessons-on-empty-rows
+                                           nextLessonInfoVec))
+                   [])

             ; find timeslot to shift up to replace gap
             :else
-            (let [currentLessonInfo       (first currentLessonInfoSeq)
-                  rowNum                  (:rowNum currentLessonInfo)
+            (let [augTTLessonInfo         (first sortedAugTTLessonInfoSeq)
+                  rowNum                  (:rowNum augTTLessonInfo)
+                  ; TODO: Rename this
                   replacementTTRowLessons (find-replacement-lessons-within-time
-                                            currentLessonInfo)]
+                                            augTTLessonInfo)]
+              ; TODO: Continue editing here
               (doseq [ttRowLesson replacementTTRowLessons]
                 (shift-lesson-to-row ttRowLesson rowNum))
               ; TODO: `replacementLessons` is not in the format we want. Make it so.
-              (recur (rest currentLessonInfoSeq)
+              (recur (rest sortedAugTTLessonInfoSeq)
                      ; append newly shifted lessons to nextLessonInfoVec
                      (loop [newlyShiftedLessons    replacementLessons
                             nextLessonInfoVecPrime nextLessonInfoVec]
@@ -881,7 +899,7 @@
                 rowNum       (:rowNum ttLessonInfoAug)
                 ttLessonInfo (dissoc ttLessonInfoAug :day :rowNum)]
           (timetable-remove-lesson day rowNum ttLessonInfo)))
-        (shift-lessons-upwards-to-replace-empty-slots seqOfRemovedLessons)
+        (shift-lessons-upwards-to-replace-empty-slots ttLessonInfoAugmentedSeq)
         ; TODO: Modify `ModulesSelected` to update :rowNum

         ; Remove from `ModulesSelected`


Added Freese-Layout

Added Freese-Layout

with rotation!

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

--- src/conexp/contrib/draw/lattices.clj
+++ src/conexp/contrib/draw/lattices.clj
@@ -62,7 +62,7 @@
   (:import [javax.swing JFrame JPanel JButton JTextField JLabel
                         JSeparator SwingConstants BoxLayout Box
                         JScrollBar JComboBox JScrollPane JFileChooser
-                        JSlider]
+                        JSlider JSpinner]
            [javax.swing.filechooser FileNameExtensionFilter]
            [java.awt Canvas Color Dimension BorderLayout GridLayout Component Graphics]
            [java.awt.event ActionEvent ActionListener]
@@ -318,6 +318,34 @@
       (save-layout nil))
     (save-layout nil)))

+;;; Freese layout
+
+(defn- freese
+  [frame scn buttons]
+  (let [^JButton btn    (make-button buttons "Freese"),
+        ^JSpinner spn   (make-spinner buttons 0 (* 2 Math/PI) 0 0.01),
+        layout          (freese-layout (lattice (get-layout-from-scene scn))),
+        get-value       #(.getValue spn),
+        ^JButton rotate (make-button buttons "Rotate"),
+        rotate-thread   (atom nil)]
+    (with-action-on btn
+      (update-layout-of-scene scn (layout (get-value))))
+    (with-change-on spn
+      (update-layout-of-scene scn (layout (get-value))))
+    (with-action-on rotate
+      (if-not (nil? @rotate-thread)
+        (do
+          (.stop @rotate-thread)
+          (reset! rotate-thread nil))
+        (do
+          (reset! rotate-thread
+                  (Thread. #(doseq [angle (drop-while (let [y (get-value)]
+                                                        (fn [x] (<= x y)))
+                                                      (cycle (range 0 (* 2 Math/PI) 0.05)))]
+                              (Thread/sleep 100)
+                              (.setValue spn angle))))
+          (.start @rotate-thread))))))
+
 ;;; Technical Helpers

 (defmacro- with-layout-modifiers
@@ -366,7 +394,8 @@
         change-parameters
         improve-layout-by-force
         snapshot-saver
-        export-as-file)
+        export-as-file
+        freese)

       ;; drawing area
       (doto canvas-panel


Fix bug where PAMap/PHMap were rendered incorrectly

Rename view to collection-view
Rename inspect* to inspect

--- src/ankha/core.cljs
+++ src/ankha/core.cljs
@@ -1,9 +1,10 @@
 (ns ankha.core
   (:refer-clojure :exclude [empty? inspect])
-  (:require [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true]
-            [clojure.string :as string]
-            [goog.object :as object]))
+  (:require
+   [om.core :as om :include-macros true]
+   [om.dom :as dom :include-macros true]
+   [clojure.string :as string]
+   [goog.object :as object]))

 (enable-console-print!)

@@ -43,17 +44,17 @@
 ;; ---------------------------------------------------------------------
 ;; View helpers

-(declare view)
-
-(defn- literal [class x]
+(declare collection-view)
+
+(defn literal [class x]
   (dom/span #js {:className class :key x}
     (pr-str x)))

 (defn coll-view [data opener closer class]
-  (om/build view data
+  (om/build collection-view data
     {:opts {:opener opener :closer closer :class class}}))

-(defn inspect* [x]
+(defn inspect [x]
   (cond
     (satisfies? IInspect x)
     (-inspect x)
@@ -62,7 +63,7 @@
     :else
     (literal "literal" x)))

-(defn- associative->dom
+(defn associative->dom
   [data {:keys [entry-class key-class val-class]}]
   (into-array
     (for [[k v] data]
@@ -72,22 +73,22 @@
           (dom/span #js {:className (str "key " key-class)
                          :style #js {:display "inline-block"
                                      :verticalAlign "top"}}
-            (inspect* k))
+            (inspect k))
           (dom/span #js {:style #js {:display "inline-block"
                                      :width "1em"}})
           (dom/span #js {:className (str "val " val-class)
                          :style #js {:display "inline-block"
                                      :verticalAlign "top"}}
-            (inspect* v)))))))
-
-(defn- sequential->dom [data]
+            (inspect v)))))))
+
+(defn sequential->dom [data]
   (into-array
     (for [[i x :as pair] (map-indexed vector data)]
       (dom/li #js {:className "entry"
                    :key (str pair)}
-        (inspect* x)))))
-
-(defn- coll->dom [data]
+        (inspect x)))))
+
+(defn coll->dom [data]
   (cond
    (map? data)
    (associative->dom data {:entry-class "map-entry"
@@ -124,7 +125,8 @@
 ;; ---------------------------------------------------------------------
 ;; Main component

-(defn- view [data owner {:keys [class opener closer] :as opts}]
+(defn collection-view
+  [data owner {:keys [class opener closer] :as opts}]
   (reify
     om/IInitState
     (init-state [_]
@@ -171,7 +173,7 @@
                                    :whiteSpace "pre-wrap"
                                    :width "100%"
                                    :overflowX "scroll"}}
-           (inspect* data))))))
+           (inspect data))))))

 ;; ---------------------------------------------------------------------
 ;; IInspect Implementation
@@ -183,6 +185,14 @@
   Symbol
   (-inspect [this] (literal "symbol" this))

+  PersistentArrayMap
+  (-inspect [this]
+    (coll-view this "{" "}" "map persistent-array-map"))
+
+  PersistentHashMap
+  (-inspect [this]
+    (coll-view this "{" "}" "map persistent-array-map"))
+
   PersistentVector
   (-inspect [this] (coll-view this "[" "]" "vector"))


Get rid of :order in the ast

Get rid of :order in the ast

--- src/aurora/ast.cljs
+++ src/aurora/ast.cljs
@@ -4,9 +4,6 @@

 (defchecked id! [x]
   (check (string? x)))
-
-(defchecked order! [x]
-  (check (number? x)))

 (defchecked js! [x]
   (check (string? x)))
@@ -90,8 +87,7 @@
          (every? branch! (:branches x))))

 (defchecked step! [x]
-  (check (id! (:id x))
-         (order! (:order x)))
+  (check (id! (:id x)))
   (case (:type x)
     :call (call! x)
     :constant (constant! x)
@@ -103,70 +99,63 @@
          (id! (:id x))
          (sequential? (:args x))
          (every? id! (:args x))
-         (map? (:steps x))
-         (every? step! (vals (:steps x)))))
+         (sequential? (:steps x))
+         (every? step! (:steps x))))

 (defchecked notebook! [x]
   (check (= :notebook (:type x))
          (id! (:id x))
-         (map? (:pages x))
-         (every? page! (vals (:pages x)))))
+         (sequential? (:pages x))
+         (every? page! (:pages x))))

 ;; examples

 (def example-a
   {:type :notebook
    :id "example_a"
-   :pages {"root" {:type :page
-                   :order 0
-                   :id "root"
-                   :args ["a" "b" "c"]
-                   :steps {"b_squared" {:id "b_squared"
-                                        :type :call
-                                        :order 0
-                                        :ref {:type :ref/js
-                                              :js "cljs.core._STAR_"}
-                                        :args [{:type :ref/id :id "b"} {:type :ref/id :id "b"}]}
-                           "four" {:id "four"
-                                   :order 1
-                                   :type :constant
-                                   :data 4}
-                           "four_a_c" {:id "four_a_c"
-                                       :order 2
-                                       :type :call
-                                       :ref {:type :ref/js
-                                             :js "cljs.core._STAR_"}
-                                       :args [{:type :ref/id :id "four"} {:type :ref/id :id "a"} {:type :ref/id :id "c"}]}
-                           "result" {:id "result"
-                                     :order 3
-                                     :type :call
-                                     :ref {:type :ref/js
-                                           :js "cljs.core._"}
-                                     :args [{:type :ref/id :id "b_squared"} {:type :ref/id :id "four_a_c"}]}}}}})
+   :pages [{:type :page
+            :id "root"
+            :args ["a" "b" "c"]
+            :steps [{:id "b_squared"
+                     :type :call
+                     :ref {:type :ref/js
+                           :js "cljs.core._STAR_"}
+                     :args [{:type :ref/id :id "b"} {:type :ref/id :id "b"}]}
+                    {:id "four"
+                     :type :constant
+                     :data 4}
+                    {:id "four_a_c"
+                     :type :call
+                     :ref {:type :ref/js
+                           :js "cljs.core._STAR_"}
+                     :args [{:type :ref/id :id "four"} {:type :ref/id :id "a"} {:type :ref/id :id "c"}]}
+                    {:id "result"
+                     :type :call
+                     :ref {:type :ref/js
+                           :js "cljs.core._"}
+                     :args [{:type :ref/id :id "b_squared"} {:type :ref/id :id "four_a_c"}]}]}]})

 (notebook! example-a)

 (def example-b
   {:type :notebook
    :id "example_b"
-   :pages {"root" {:type :page
-                   :id "root"
-                   :order 1
-                   :args ["x"]
-                   :steps {"result" {:id "result"
-                                     :type :match
-                                     :order 0
-                                     :arg {:type :ref/id :id "x"}
-                                     :branches [{:type :match/branch
-                                                 :pattern {"a" {:type :match/bind :id "a" :pattern {:type :ref/js :js "cljs.core.number_QMARK_"}}
-                                                           "b" {:type :match/bind :id "b" :pattern {:type :ref/js :js "cljs.core.number_QMARK_"}}}
-                                                 :action {:type :call
-                                                          :ref {:type :ref/js :js "cljs.core._"}
-                                                          :args [{:type :ref/id :id "a"} {:type :ref/id :id "b"}]}}
-                                                {:type :match/branch
-                                                 :pattern [{:type :match/bind :id "y" :pattern {:type :match/any}} "foo"]
-                                                 :action {:type :constant
-                                                          :data {:type :ref/id
-                                                                 :id "y"}}}]}}}}})
+   :pages [{:type :page
+            :id "root"
+            :args ["x"]
+            :steps [{:id "result"
+                     :type :match
+                     :arg {:type :ref/id :id "x"}
+                     :branches [{:type :match/branch
+                                 :pattern {"a" {:type :match/bind :id "a" :pattern {:type :ref/js :js "cljs.core.number_QMARK_"}}
+                                           "b" {:type :match/bind :id "b" :pattern {:type :ref/js :js "cljs.core.number_QMARK_"}}}
+                                 :action {:type :call
+                                          :ref {:type :ref/js :js "cljs.core._"}
+                                          :args [{:type :ref/id :id "a"} {:type :ref/id :id "b"}]}}
+                                {:type :match/branch
+                                 :pattern [{:type :match/bind :id "y" :pattern {:type :match/any}} "foo"]
+                                 :action {:type :constant
+                                          :data {:type :ref/id
+                                                 :id "y"}}}]}]}]})

 (notebook! example-b)


add more pre-checks for comp and head

add more pre-checks for comp and head

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -106,6 +106,10 @@
                   (get-in child [:synsem :sem :reflexive] :top)))
    (fail? (unifyc (get-in parent [:head :synsem :sem :tense] :top)
                   (get-in child [:synsem :sem :tense] :top)))
+   (fail? (unifyc (get-in parent [:head :synsem :sem :pred] :top)
+                  (get-in child [:synsem :sem :pred] :top)))
+   (fail? (unifyc (get-in parent [:head :synsem :aux] :top)
+                  (get-in child [:synsem :aux] :top)))
    (fail? (unifyc (get-in parent [:synsem :cat] :top)
                   (get-in child [:synsem :cat] :top)))
    (fail? (unifyc (get-in parent [:head :synsem :cat] :top)
@@ -121,6 +125,12 @@
                   (get-in child [:synsem :cat])))
    (fail? (unifyc (get-in parent [:comp :synsem :agr] :top)
                   (get-in child [:synsem :agr] :top)))
+   (fail? (unifyc (get-in parent [:comp :synsem :case] :top)
+                  (get-in child [:synsem :case] :top)))
+   (fail? (unifyc (get-in parent [:comp :synsem :sem] :top)
+                  (get-in child [:synsem :sem] :top)))
+   (fail? (unifyc (get-in parent [:comp :synsem :reflexive] :top)
+                  (get-in child [:synsem :reflexive] :top)))
    (fail? (unifyc (get-in parent [:comp :synsem :pronoun] :top)
                   (get-in child [:synsem :pronoun] :top)))
    (fail? (unifyc (get-in parent [:comp :synsem :subcat] :top)


display invalid credentials on wrong username or password submission

--- src_cljs/rrm/corecljs.cljs
+++ src_cljs/rrm/corecljs.cljs
@@ -157,19 +157,20 @@
             [:div {:style  {:color "red"}} [:b (str (first ((login-validator @data-set) id)))]])
           [:div])])))

-          (defn submit-login [data-set focus]
-            (if (= nil (login-validator @data-set))
-              (let [onresp (fn [json]
-                             (if (= (get-status json) 200)
-                               ((set-key-value :user (.-_2 (getdata json)))
-                                (set-key-value :token (.-_1 (getdata json)))
-                                (set-item local-storage "session" {:current-url "/" :user-info
-                                                                   {:token (get-value! :token)
-                                                                    :user (get-value! :user)}})
-                                (reset-login-page)
-                                (accountant/navigate! "/"))))]
-                (http-post (str serverhost "login") onresp (.serialize (Serializer.) (clj->js @data-set ))))
-              (reset! focus "on")))
+(defn submit-login [data-set focus]
+  (if (= nil (login-validator @data-set))
+    (let [onresp (fn [json]
+                   (cond (= (get-status json) 200) (do
+                                                     (set-key-value :user (.-_2 (getdata json)))
+                                                     (set-key-value :token (.-_1 (getdata json)))
+                                                     (set-item local-storage "session" {:current-url "/" :user-info
+                                                                                {:token (get-value! :token)
+                                                                                :user (get-value! :user)}})
+                                                     (reset-login-page)
+                                                     (accountant/navigate! "/"))
+                         :else (set! (.-display (.-style (dom/getElement "invalid"))) "block")))]
+      (http-post (str serverhost "login") onresp (.serialize (Serializer.) (clj->js @data-set ))))
+    (reset! focus "on")))

@@ -177,7 +178,9 @@
 (defn submit-button [data-set focus]
   [:div.row
    [:div.col-md-4
-    [:button {:class "btn btn-primary btn-block btn-flat" :on-click #(submit-login data-set focus)} "Sign In" ]]])
+    [:button {:class "btn btn-primary btn-block btn-flat" :on-click #(submit-login data-set focus)} "Sign In" ]]
+   [:div.col-sm-8
+    [:label#invalid {:style {:color "red" :display "none"}} "Invalid Credentials"]]])

 (defn login []
   (let [my-data (r/atom  {})


[#2145] Fix loading spec in validation op-spec

--- backend/src/akvo/lumen/lib/transformation/derive_category.clj
+++ backend/src/akvo/lumen/lib/transformation/derive_category.clj
@@ -10,16 +10,14 @@
             [clojure.walk :as walk]
             [hugsql.core :as hugsql]
             [clojure.spec.alpha :as s]
-            [akvo.lumen.specs.transformation]))
-
-(alias 'transformation.engine.s 'akvo.lumen.specs.transformation.engine)
+            [akvo.lumen.specs.transformation :as transformation.s]))

 (hugsql/def-db-fns "akvo/lumen/lib/transformation/derive.sql")
 (hugsql/def-db-fns "akvo/lumen/lib/transformation/engine.sql")

 (defmethod engine/valid? "core/derive-category"
   [op-spec]
-  (s/valid? ::transformation.engine.s/op-spec (walk/keywordize-keys op-spec)))
+  (s/valid? ::transformation.s/op-spec (walk/keywordize-keys op-spec)))

 (defn mappings-dict [mappings]
        (reduce (fn [c [source-vals mapped-val]]


Removing unused file.

Removing unused file.

--- src/script/core.clj
+++ src/script/core.clj
@@ -1,7 +0,0 @@
-(ns script-module.core
-  (:gen-class))
-
-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))


Made static-page more generic.

Made static-page more generic.

--- src/lambda_blog/templates/static.clj
+++ src/lambda_blog/templates/static.clj
@@ -6,13 +6,15 @@
             [lambda-blog.utils :refer [path]]
             [s-html.tags :refer [article body div doctype html]]))

-(defn static-page [{:keys [contents] :as ent}]
+(defn static-page-template [contents-template entity]
   [(doctype :html)
-   (html (header ent)
-         (body (navigation ent)
+   (html (header entity)
+         (body (navigation entity)
                (div {:class :body-wrap}
                     (article {:id :page}
                              (div {:class :container}
-                                  (banner ent)
-                                  contents
-                                  (footer ent))))))])
+                                  (banner entity)
+                                  (contents-template entity)
+                                  (footer entity))))))])
+
+(def static-page (partial static-page-template :contents))


Read from stdin

Read from stdin

--- src/spark/core.cljs
+++ src/spark/core.cljs
@@ -1,5 +1,6 @@
 (ns spark.core
-  (:require [clojure.string :as string]))
+  (:require [clojure.string :as string]
+            [cljs.nodejs :as node]))

 (defn print-usage? [args]
   (or (not (seq args)) (= "-h" (first args))))
@@ -33,10 +34,35 @@
     ;(println (map #(tick-pos %) numbers))
     (println (apply str (map #(nth ticks (tick-pos %)) numbers)))))

+(defn read-from-stdin? []
+  (not node/process.stdin.isTTY))
+
+;(def http (node/require "http"))
+;(def stdin (. node/process (stdin)))
+
 (defn start [& args]
-  ;(println (type (first args)))
-  (if (print-usage? args)
-      (print-usage)
-      (print-graph args)))
+  ;(println (not node/process.stdin.isTTY))
+  ;(if (not node/process.stdin.isTTY)
+  (if (read-from-stdin?)
+    (do
+      ;(println "reading from stdin!")
+      (. node/process.stdin (resume))
+      (.setEncoding node/process.stdin "utf8")
+      ;(println (. node/process.stdin (read)))
+      (.on node/process.stdin "data" (fn [e]
+                                       ;(println (string/ e)))))
+                                       (print-graph (conj '() (string/trim-newline e))))))
+      ;(.on node/process.stdin "readable" (fn [e]
+      ;                                  (println "stuff is readable")))
+  ;(.on node/process.stdin "close" (fn [e]
+  ;                                  (println "stuff is closed")))
+      ;(.on node/process.stdin "end" (fn [e]
+      ;                                  (println "ended"))))
+  ;(. stdin (resume))
+  ;(.setEncoding stdin "utf8")
+  ;(println (line-seq (java.io.BufferedReader. *in*)))
+    (if (print-usage? args)
+        (print-usage)
+        (print-graph args))))

 (set! *main-cli-fn* start)


Only try to substring match project names not containing a "/".

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -683,7 +683,9 @@
   (p-repos (fn [p] (tag-repo-projects p)))
   (doseq [:let [deps (fold-args-as-meta adeps)]
           dep deps
-          :let [full-projs (resolve-short-proj (pr-str dep))
+          :let [full-projs (if (.contains (str dep) "/")
+                             [dep]
+                             (resolve-short-proj (pr-str dep)))
                 full-projs (map symbol full-projs)
                 repo-infos (mapcat #(newest-voom-ver-by-spec % (meta dep)) full-projs)]]
     (case (count repo-infos)


Add support for --no-fetch to freshen

Add support for --no-fetch to freshen

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -534,8 +534,10 @@
   there so voom can find your deps.

   Example: lein voom freshen"
-  [project]
+  [project & args]
   (ensure-deps-repos (:dependencies project))
+  (when (not-any? #{"--no-fetch"} args)
+    (fetch-all (all-repos-dirs)))
   (let [prj-file-name (str (:root project) "/project.clj")
         old-deps (:dependencies project)
         desired-new-deps (doall (map #(fresh-version %) old-deps))]


Fix two issues in 'newest-voom-ver-by-spec.

There were two issues here:
  - tags for elimination were not limited to found-branch
  - tags for elimination were not limited to this ref

Both of these issues were of the same type. Unrelated tags could over
zealously prune history needed to find commits for a given proj-name +
branch + path.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -3,6 +3,7 @@
             [clojure.string :as s]
             [clojure.pprint :refer [pprint print-table]]
             [clojure.java.io :as io]
+            [clojure.set :as set]
             [leiningen.core.project :as project]
             [leiningen.core.main :as lmain]
             [org.satta.glob :refer [glob]]
@@ -427,7 +428,7 @@
         :let [ptn (s/join "--" ["voom"
                                 (str (namespace proj-name) "%" (name proj-name))
                                 (str ver-spec "*")])
-              tags (:lines (git {:gitdir gitdir} "tag" "--list" ptn))
+              tags (set (:lines (git {:gitdir gitdir} "tag" "--list" ptn)))
               ;;_ (prn :tags tags)
               tspecs (if (= tags [""])
                        []
@@ -437,8 +438,13 @@
         :when (or (= found-path path) (nil? path))
         found-branch (origin-branches gitdir)
         :when (or (= found-branch branch) (nil? branch))
-        :let [tags-with-parents (remove #(.endsWith ^String % "--no-parent") tags)
-              neg-tags (map #(str "^" % "^") tags-with-parents)
+        :let [not-not-tags (set (mapcat #(:refs (parse-sha-refs %))
+                                        (:lines (git {:gitdir gitdir} "log" "--pretty=format:%H,%cd,%p,%d" "--all"
+                                                     "--simplify-by-decoration" "-m" (str "^origin/" found-branch)))))
+              yes-yes-tags (set/difference tags not-not-tags)
+              tags-with-parents (remove #(.endsWith ^String % "--no-parent") yes-yes-tags)
+              tags-here-with-parents (filter #(= found-path (:path (parse-tag %))) tags-with-parents)
+              neg-tags (map #(str "^" % "^") tags-here-with-parents)
               commits
               , (map
                  parse-sha-refs


New 'marked-newest-ver-by-spec querying code.

This is not yet hooked into the CLI yet but is placed as development
alternate.

This new 'marked-newest-ver-by-spec querying code is believed to be
correct. It has been tested against all previously known degenerate
cases and handles them properly. There are also a couple of other
unexpected cases that we have discovered which it also handles
properly.

This code is not superbly fast (taking nearly 3s for our largest repo)
but it is usably fast.

The naming is terrible but will be cleaned up on refactor. Names are
largely designated to indicate what phase (listed in the docstring) is
being performed.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1278,6 +1278,80 @@
   Example: lein voom update-repo-dbs"
   [_]
   (time (p-repos (fn [p] (updated-git-db p)))))
+
+;; ===== latest version querying =====
+
+(defn compare-max [& xs]
+  (when (seq xs)
+    (reduce #(if (neg? (compare %1 %2)) %2 %1) xs)))
+
+(defn marked-newest-voom-ver-by-spec
+"
+  proj dir change -> commit where a change happened in a subtree rooted with a project.clj
+  - mark all project directory changes with project.clj version info
+  - a. narrow proj dir changes by proj name spec
+  - a2. narrow all proj dir changes by *this* proj dir
+  - b. for each branch (matching spec) narrow proj dir changes by branch reachability
+  - c. narrow proj dir changes further by version range (spec)
+  - d. find max sem ver
+  - e. narrow proj dir changes further by max sem ver
+  - f. narrow proj dir changes to candidates by finding proj dir changes
+       with no childer proj dir changes in this set
+"
+  [proj-name {:keys [sha version repo branch path allow-snaps]
+              :or {allow-snaps true sha (l/lvar)}}]
+  (for [gitdir (all-repos-dirs)
+        :when (or (nil? repo) (= repo (-> (remotes gitdir) :origin :fetch)))
+        :let [sha (if (string? sha)
+                    (sha/mk sha)
+                    sha)
+              {:keys [shabam pldb]} (updated-git-db gitdir)
+              nupes-a (->>
+                       (q pldb [msha ctime path version has-snaps?]
+                          (l/fresh [bsha]
+                                   (l/== msha sha)
+                                   (r-proj bsha proj-name version has-snaps?)
+                                   (r-proj-path sha path bsha)
+                                   (r-commit-path sha path)
+                                   (r-commit sha ctime _)))
+                       (map #(zipmap [:sha :ctime :path :version :has-snaps?]
+                                     %)))
+              paths (distinct (map :path nupes-a))]
+        found-path paths
+        :when (or (= found-path path) (nil? path))
+        [found-branch branch-sha] (q pldb [ref sha] (r-branch _ ref sha))
+        :when (or (= found-branch branch) (nil? branch))
+        :let [nupes-a2 (filter #(= (:path %) found-path) nupes-a)
+              sha-nupes-a (group-by :sha nupes-a2)
+              shas-b (sha-ancestors shabam branch-sha (map :sha nupes-a2))
+              shas-b (if (contains? sha-nupes-a branch-sha)
+                       (conj shas-b branch-sha)
+                       shas-b)
+              gvs (GenericVersionScheme.)
+              version-constraint (when version
+                                   (.parseVersionConstraint gvs version))
+              nupes-c (if version
+                        (keep #(let [[nupe] (get sha-nupes-a %)]
+                                 (when (.containsVersion
+                                        version-constraint
+                                        (.parseVersion gvs (:version nupe)))
+                                   nupe))
+                              shas-b)
+                        (map (comp first sha-nupes-a) shas-b))
+              [_ max-ver-d] (apply compare-max
+                                   (map #(vector (when % (.parseVersion gvs %)) %)
+                                        (distinct (map :version nupes-c))))
+              nupes-e (filter #(= max-ver-d (:version %)) nupes-c)
+              shas-e (map :sha nupes-e)
+              nupes-f (remove #(seq (sha-successors shabam (:sha %) shas-e)) nupes-e)]
+        {:keys [sha ctime]} nupes-f]
+    {:sha sha
+     :ctime ctime
+     :version max-ver-d
+     :path found-path
+     :proj proj-name
+     :gitdir gitdir
+     :branch found-branch}))

 ;; ===== point filtering query =====


graph calculation bits, WIP

graph calculation bits, WIP

--- samples/twitterbuzz/src/twitterbuzz/stats.cljs
+++ samples/twitterbuzz/src/twitterbuzz/stats.cljs
@@ -19,8 +19,44 @@
         tweet-ids (keys retweet-counts)]
     (take n (sort-by #(get retweet-counts %) tweet-ids))))

+(defn retweet-of
+  "Returns the username of the user who originally authored the tweet
+  that t is a retweet of, nil otherwise"
+  [t]
+  (get-in t ["retweeted_status" "user" "name"]))
+
+(defn mentioned-users
+  "Returns the usernames of all the users mentioned in tweet t"
+  [t]
+  (map #(get % "screen_name") (get-in t ["entities" "user_mentions"])))
+
+(defn new-edges
+  "Filter the seq of sets n to find all sets in n that do not already
+  exist in the seq of sets o"
+  [n o]
+  (filter #(not (contains? o %)) n))
+
+(defn edges
+  "Return a lazy seq of pairs of usernames representing the social edges of a tweet
+  stream, where a social edge is defined as one user retweeting or
+  mentioning another user in a given tweet. Edges are not directional; if
+  @alice retweets @bob, and @bob mentions @alice, those two tweets only create
+  one edge."
+  ([ts]
+     (edges ts #{}))
+  ([ts edges]
+     (let [t (first ts)
+           other-users (concat (list (retweet-of t)) (mentioned-users t))
+           author (get-in t ["user" "name"])
+           tweet-edges (set (map #(set (list author %)) other-users))
+           new-edges (new-edges tweet-edges edges)]
+       (when t
+         (if (empty? new-edges)
+           (recur (rest ts) edges)
+           (lazy-seq (concat new-edges (edges (rest ts) (concat new-edges edges)))))))))
+
 (defn graph
   "Returns a map representing the graph of the tweet seq ts"
   [ts]
-  {:nodes []
+  {:nodes {}
    :edges []})


CMR-1397: Added test for get-search-results-format-test

--- search-app/test/cmr/search/test/api/routes.clj
+++ search-app/test/cmr/search/test/api/routes.clj
@@ -1,10 +1,14 @@
 (ns cmr.search.test.api.routes
   (:require [clojure.test :refer :all]
-            [cmr.search.api.routes :as r])
+            [cmr.search.api.routes :as r]
+            [cmr.common.util :as util])
   (:use ring.mock.request))

 (def ^:private api (#'cmr.search.api.routes/build-routes
                      {:search-public-conf {:protocol "https" :relative-root-url "/search"}}))
+
+;; referring the private get-search-results-format function into this namespace for testing
+(def get-search-results-format (ns-resolve 'cmr.search.api.routes 'get-search-results-format))

 (defn- substring?
   [test-value string]
@@ -40,4 +44,77 @@
          "foo=0&foo[]=1&foo[]=2" nil
          "foo[bar]=1&foo[x]=2" nil
          "foo=1&options[foo][pattern]=true" nil
-         "foo[]=1&options[foo][pattern]=true" nil)))+         "foo[]=1&options[foo][pattern]=true" nil)))
+
+(deftest get-search-results-format-test
+  (testing "format from headers"
+    (are [path headers default-mime-type expected-format]
+         (=  expected-format (get-search-results-format path headers default-mime-type))
+         ;; Accept header
+         "search/collections" {"accept" "application/echo10+xml"} "application/xml" :echo10
+         "search/collections" {"accept" "application/dif+xml"} "application/xml" :dif
+         "search/collections" {"accept" "application/dif10+xml"} "application/xml" :dif10
+         "search/collections" {"accept" "application/iso19115+xml"} "application/xml" :iso19115
+         "search/collections" {"accept" "application/xml"} "application/json" :xml
+         "search/collections" {"accept" "application/json"} "application/xml" :json
+         "search/collections" {"accept" "application/atom+xml"} "application/xml" :atom
+         "search/collections" {"accept" "application/opendata+json"} "application/xml" :opendata
+         "search/collections" {"accept" "application/vnd.google-earth.kml+xml"} "application/xml" :kml
+         "search/collections" {"accept" "text/csv"} "application/xml" :csv
+         "search/collections" {"accept" "application/metadata+xml"} "application/xml" :native
+
+         ;; Content-Type header
+         "search/collections" {"content-type" "application/echo10+xml"} "application/xml" :echo10
+         "search/collections" {"content-type" "application/dif+xml"} "application/xml" :dif
+         "search/collections" {"content-type" "application/dif10+xml"} "application/xml" :dif10
+         "search/collections" {"content-type" "application/iso19115+xml"} "application/xml" :iso19115
+         "search/collections" {"content-type" "application/xml"} "application/json" :xml
+         "search/collections" {"content-type" "application/json"} "application/xml" :json
+         "search/collections" {"content-type" "application/atom+xml"} "application/xml" :atom
+         "search/collections" {"content-type" "application/opendata+json"} "application/xml" :opendata
+         "search/collections" {"content-type" "application/vnd.google-earth.kml+xml"} "application/xml" :kml
+         "search/collections" {"content-type" "text/csv"} "application/xml" :csv
+         "search/collections" {"content-type" "application/metadata+xml"} "application/xml" :native
+
+         ;; Both headers - Accept header wins out
+         "search/collections" {"accept" "application/echo10+xml" "content-type" "application/json"} "application/xml" :echo10
+         "search/collections" {"accept" "application/dif+xml" "content-type" "application/json"} "application/xml" :dif
+         "search/collections" {"accept" "application/dif10+xml" "content-type" "application/json"} "application/xml" :dif10
+         "search/collections" {"accept" "application/iso19115+xml" "content-type" "application/json"} "application/xml" :iso19115
+         "search/collections" {"accept" "application/xml" "content-type" "application/json"} "application/json" :xml
+         "search/collections" {"accept" "application/json" "content-type" "application/xml"} "application/xml" :json
+         "search/collections" {"accept" "application/atom+xml" "content-type" "application/json"} "application/xml" :atom
+         "search/collections" {"accept" "application/opendata+json" "content-type" "application/json"} "application/xml" :opendata
+         "search/collections" {"accept" "application/vnd.google-earth.kml+xml" "content-type" "application/json"} "application/xml" :kml
+         "search/collections" {"accept" "text/csv" "content-type" "application/json"} "application/xml" :csv
+         "search/collections" {"accept" "application/metadata+xml" "content-type" "application/json"} "application/xml" :native))
+
+  (testing "format from extension"
+    (are [path headers default-mime-type expected-format]
+         (=  expected-format (get-search-results-format path headers default-mime-type))
+         "search/collections.echo10" {"accept" "application/dif+xml"} "application/xml" :echo10
+         "search/collections.dif" {"accept" "application/json"} "application/xml" :dif
+         "search/collections.dif10" {"accept" "application/json"} "application/xml" :dif10
+         "search/collections.iso19115" {"accept" "application/json"} "application/xml" :iso19115
+         "search/collections.xml" {"accept" "application/dif+xml"} "application/json" :xml
+         "search/collections.json" {"accept" "application/dif+xml"} "application/xml" :json
+         "search/collections.atom" {"accept" "application/json"} "application/xml" :atom
+         "search/collections.opendata" {"accept" "application/json"} "application/xml" :opendata
+         "search/collections.kml" {"accept" "application/json"} "application/xml" :kml
+         "search/collections.csv" {"accept" "application/json"} "application/xml" :csv
+         "search/collections.native" {"accept" "application/json"} "application/xml" :native))
+
+  (testing "using default format"
+    (are [path headers default-mime-type expected-format]
+         (=  expected-format (get-search-results-format path headers default-mime-type))
+         "search/collections" {} "application/echo10+xml" :echo10
+         "search/collections" {} "application/dif+xml" :dif
+         "search/collections" {} "application/dif10+xml" :dif10
+         "search/collections" {} "application/iso19115+xml" :iso19115
+         "search/collections" {} "application/xml" :xml
+         "search/collections" {} "application/json" :json
+         "search/collections" {} "application/atom+xml" :atom
+         "search/collections" {} "application/opendata+json" :opendata
+         "search/collections" {} "application/vnd.google-earth.kml+xml" :kml
+         "search/collections" {} "text/csv" :csv
+         "search/collections" {} "application/metadata+xml" :native)))


Don't need the clj when you have cljc

Don't need the clj when you have cljc

--- src/tracks/core.clj
+++ src/tracks/core.clj
@@ -1,131 +0,0 @@
-(ns tracks.core
-  (:require [clojure.walk :as w]
-            [clojure.set :as set]))
-
-(defn- shallow->m [coll]
-  (with-meta
-    (if (or (list? coll) (vector? coll))
-      (->> coll
-           (map-indexed (fn [idx x] [idx x]))
-           (into {}))
-      coll )
-    {::type (type coll)}))
-
-(defn- m-able? [x]
-  (and (not= clojure.lang.MapEntry (type x))
-       (or (list? x) (vector? x))))
-
-(defn ->m [coll]
-  (w/prewalk (fn [x] (if (m-able? x) (shallow->m x) x)) coll))
-
-(defn m->list [m-map]
-  (map m-map (range 0 (count m-map))))
-
-(defn m->vec [m-map]
-  (mapv m-map (range 0 (count m-map))))
-
-(defn shallow<-m [m-map]
-  (if-let [type (::type (meta m-map))]
-    (let [operator ({clojure.lang.PersistentVector m->vec
-                     clojure.lang.PersistentList m->list}
-                    type)]
-      (operator m-map))
-    (throw (ex-info
-            (str "m-map called on something without :tracks.core/type metadata: "
-                 m-map " metadata: " (meta m-map)) {}))))
-
-(defn <-m [m-map]
-  (w/postwalk
-   (fn [x] (if (::type (meta x)) (shallow<-m x) x))
-   m-map))
-
-(defn- keys-into [m]
-  (if (map? m)
-    (vec
-     (mapcat (fn [[k v]]
-               (let [nested (->> (keys-into v)
-                                 (filter (comp not empty?))
-                                 (map #(into [k] %)))]
-                 (if (seq nested) nested [[k]])))
-             m))
-    []))
-
-(defn paths [m]
-  (->> (keys-into m)
-       (mapv (fn [path]
-               (let [leaf-value (get-in m path)]
-                 [leaf-value path])))
-       (into {})))
-
-(defn dissoc-in
-  "Dissociates an entry from a nested associative structure returning a new
-  nested structure. keys is a sequence of keys. Any empty maps that result
-  will not be present in the new structure."
-  [m [k & ks :as keys]]
-  (if ks
-    (if-let [nextmap (get m k)]
-      (let [newmap (dissoc-in nextmap ks)]
-        (if (seq newmap)
-          (assoc m k newmap)
-          (dissoc m k)))
-      m)
-    (dissoc m k)))
-
-(defmacro let-track
-  "All track bindings that are symbols will be destructed into a let binding."
-  [bindings & body]
-  (assert (and (vector? bindings)
-               (seq bindings))
-          "Must supply a vector of bindings")
-  (assert (even? (count bindings))
-          "Each binding must be a pair")
-  (let [bindings#
-        (->> bindings
-             (partition 2)
-             (mapcat
-              (fn [[track# input#]]
-                (let [sym# (gensym)
-
-                      track-bindings#
-                      (->> track#
-                           ->m
-                            paths
-                            (filter #(symbol? (first %))))]
-                  (assert (seq track-bindings#)
-                          (str "No bindings found in track: " track#))
-                  (concat
-                    [sym# input#]
-                    (mapcat
-                      (fn [[b# v#]]
-                        [b# `(get-in ~sym# ~v#)])
-                      track-bindings#)))))
-             (vec))]
-        `(let ~bindings# ~@body)))
-
-(defn track
-  "Given two maps in and out, returns f s.t. f(in) = out for all shared keys.
-  -----
-  Given two maps in out, and value->fxn,
-  returns f s.t. f(in) = out with functions applied to the "
-  ([in out] (track in out {}))
-  ([in out value->fxn]
-   (let [in-paths (paths (->m in))
-         out-paths (paths (->m out))]
-     (fn [input]
-       (let [m-input (->m input)
-             final-merge (reduce dissoc-in m-input (vals in-paths))]
-         (loop [out-map (->m out)
-                common-vals (vec
-                             (set/intersection
-                              (set (keys in-paths))
-                              (set (keys out-paths))))]
-           (let [current-val (first common-vals)
-                 current-fn (get value->fxn current-val identity)
-                 in-path (get in-paths current-val)
-                 out-path (get out-paths current-val)]
-             (if (nil? common-vals)
-               (<-m (merge out-map final-merge))
-               (recur
-                (assoc-in out-map out-path
-                          (-> m-input (get-in in-path) current-fn))
-                (next common-vals))))))))))


Extend basename to fully wrap node function

When invoked with two args, files/basename will now return filename sans extension if extension matches the second arg.

--- src/lt/objs/files.cljs
+++ src/lt/objs/files.cljs
@@ -214,8 +214,9 @@
 (defn absolute? [path]
   (boolean (re-seq #"^[\\\/]|([\w]+:[\\\/])" path)))

-(defn basename [path]
-  (.basename fpath path))
+(defn basename
+  ([path] (.basename fpath path))
+  ([path ext] (.basename fpath path ext)))

 (defn writable? [path]
   (let [perm (-> (.statSync fs path)


Add threshold for t2.large

Add threshold for t2.large

--- src/maestro/alarms.clj
+++ src/maestro/alarms.clj
@@ -7,7 +7,8 @@
 (def thresholds
   {"t2.micro" 15
    "t2.small" 15
-   "t2.medium" 30})
+   "t2.medium" 30
+   "t2.large" 30})

 (defn cpu-credit-balance-low-alarm
   [auto-scaling-group-name topic-arn threshold]


delete pid file when server connect fails

normally the pid file will be deleted by the server on shutdown.
that doesn't happen when it gets killed though.

closes #126

--- src/main/shadow/cljs/npm/client.cljs
+++ src/main/shadow/cljs/npm/client.cljs
@@ -2,6 +2,7 @@
   (:require [cljs.reader :as reader]
             ["readline" :as rl]
             ["net" :as node-net]
+            ["fs" :as fs]
             [shadow.cljs.npm.util :as util]
             [clojure.string :as str]))

@@ -48,28 +49,20 @@
           (.end socket)
           (println))]

-    (.on socket "connect"
-      (fn [err]
-        (if err
-          (println "shadow-cljs - socket connect failed")
+    (println "shadow-cljs - connected to server")

-          (do (println "shadow-cljs - connected to server")
-              ;; FIXME: this should be loaded but for some reason it sometimes can't find from_remote
-              (write (str "(require 'shadow.cljs.devtools.cli)\n"))
+    ;; FIXME: this is an ugly hack that will be removed soon
+    ;; its just a quick way to interact with the server without a proper API protocol
+    (write (str "(shadow.cljs.devtools.cli/from-remote " (pr-str exit-token) " " (pr-str error-token) " " (pr-str (into [] args)) ")\n"))

-              ;; FIXME: this is an ugly hack that will be removed soon
-              ;; its just a quick way to interact with the server without a proper API protocol
-              (write (str "(shadow.cljs.devtools.cli/from-remote " (pr-str exit-token) " " (pr-str error-token) " " (pr-str (into [] args)) ")\n"))
+    (.on rl "line"
+      (fn [line]
+        (write (str line "\n"))))

-              (.on rl "line"
-                (fn [line]
-                  (write (str line "\n"))))
-
-              ;; CTRL+D closes the rl
-              (.on rl "close"
-                (fn []
-                  (stop!)))
-              ))))
+    ;; CTRL+D closes the rl
+    (.on rl "close"
+      (fn []
+        (stop!)))

     (.on socket "data"
       (fn [data]
@@ -134,17 +127,10 @@
         (fn [buffer]
           (write (.toString buffer)))]

-    (.on socket "connect"
-      (fn [err]
-        (if err
-          (do (println "shadow-cljs - socket connect failed")
-              (js/process.exit 1))
+    (write (str "(shadow.cljs.devtools.cli/from-remote " (pr-str exit-token) " " (pr-str error-token) " " (pr-str (into [] args)) ")\n"))

-          (do (write (str "(shadow.cljs.devtools.cli/from-remote " (pr-str exit-token) " " (pr-str error-token) " " (pr-str (into [] args)) ")\n"))
-
-              (js/process.stdin.on "data" stdin-read)
-              (js/process.stdin.on "close" stop!)
-              ))))
+    (js/process.stdin.on "data" stdin-read)
+    (js/process.stdin.on "close" stop!)

     (.on socket "data"
       (fn [data]
@@ -180,16 +166,34 @@
         (js/process.stdin.removeListener "close" stop!)
         ))))

-(defn run [project-root config server-pid opts args]
+(defn run [project-root config server-pid-file opts args]
   (let [cli-repl
-        (-> (util/slurp server-pid)
+        (-> (util/slurp server-pid-file)
             (js/parseInt 10))]

     (if-not (pos-int? cli-repl)
-      (prn [:no-socket-repl-port server-pid cli-repl])
-      (let [socket (node-net/connect cli-repl "localhost")]
-        (if (get-in opts [:options :stdin])
-          (socket-pipe socket args)
-          (repl-client socket args)
-          )))))
+      (prn [:no-socket-repl-port server-pid-file cli-repl])
+      (let [connect-listener
+            (fn [err]
+              (this-as socket
+                (when-not
+                  (if (get-in opts [:options :stdin])
+                    (socket-pipe socket args)
+                    (repl-client socket args)))))

+            socket
+            (node-net/connect
+              #js {:port cli-repl
+                   :host "localhost"
+                   :timeout 1000}
+              connect-listener)]
+
+        (.on socket "error"
+          (fn [err]
+            (println "shadow-cljs - socket connect failed, server process dead?")
+            (fs/unlinkSync server-pid-file)
+            ;; FIXME: should do this automatically?
+            (println "deleted pid file, please retry command to start new server")
+            (js/process.exit 1)))
+        ))))
+


Revert "Move from me.raynes.fs to org.tobereplaced.nio.file"

This reverts commit d4ad3f91db5ff7c9e9cf782d99bf5eb82986e36f.

--- src/mdr2/pipeline1.clj
+++ src/mdr2/pipeline1.clj
@@ -6,7 +6,7 @@
   `/usr/lib/daisy-pipeline/scripts`."
   (:require [clojure.java.shell :refer [sh]]
             [clojure.string :as s]
-            [org.tobereplaced.nio.file :as nio]))
+            [me.raynes.fs :as fs]))

 (def ^:private install-path "/usr/lib/daisy-pipeline/scripts")

@@ -40,7 +40,7 @@
   ;; the pipeline1 validator is not so brilliant when it comes to
   ;; returning error conditions. For that reason we check for
   ;; existence of the input file before hand
-  (if (not (and (nio/exists? file) (nio/readable? file)))
+  (if (not (and (fs/exists? file) (fs/readable? file)))
     [(format "Input file '%s' does not exist or is not readable" file)]
     (let [args ["daisy-pipeline"
                 (str install-path "/verify/ConfigurableValidator.taskScript")


and voila! Reporting works once again.

and voila! Reporting works once again.

--- src/midje/ideas/reporting/report.clj
+++ src/midje/ideas/reporting/report.clj
@@ -53,7 +53,7 @@

 (letfn [(render [m]
           (->> m
-               (:single-fact-fn *report-format-config*)
+               ((:single-fact-fn *report-format-config*))
                flatten
                (remove nil?)
                (map *renderer*)


(defn anything)

(defn anything)

--- src/midje/checkers.clj
+++ src/midje/checkers.clj
@@ -13,3 +13,8 @@
 (defn in-any-order "Produces matcher that matches sequences without regard to order"
   [expected]
   (fn [actual] (= (set expected) (set actual))))
+
+(defn anything
+  "Accepts any value"
+  [actual]
+  true)


show doc-count in overview

show doc-count in overview

--- src/pc/views/admin.clj
+++ src/pc/views/admin.clj
@@ -266,6 +266,7 @@
          [:table {:border 1}
           [:tr
            [:th "subdomain"]
+           [:th "doc-count"]
            [:th "status"]
            [:th "coupon"]
            [:th "creator"]
@@ -275,6 +276,7 @@
                 :let [plan (:team/plan team)]]
             [:tr
              [:td (team-link team)]
+             [:td (count (seq (d/datoms db :vaet (:db/id team) :document/team)))]
              [:td (cond (:plan/paid? plan) "paid"
                         (not (plan-model/trial-over? plan)) "trial"
                         :else "trial expired")]


app-state observer

app-state observer

--- cloc-webapp/src-cljs/dash/dash.cljs
+++ cloc-webapp/src-cljs/dash/dash.cljs
@@ -10,23 +10,26 @@

 (enable-console-print!)

-(def app-state (atom {:current-index [0]}))
+(def app-state (atom {:current-index [0]
+                      :repos []
+                      :registered-states []}))

+;; cursors
 (defn current-index-cur []
   (om/ref-cursor (:current-index (om/root-cursor app-state))))

-(defn- repo-button [index repo]
-  (dom/button
-    #js {:onClick
-           (fn [e] (om/update! (current-index-cur) [0] index))}
-    (get repo "full_name")))
-
+;; views
 (defn repo-list-view [state owner]
   (reify
     om/IRender
     (render [this]
-      (apply dom/div nil
-        (map-indexed repo-button state)))))
+      (letfn [(repo-button [index repo]
+                (dom/button
+                  #js {:onClick
+                         (fn [e] (om/update! (current-index-cur) [0] index))}
+                  (get repo "full_name")))]
+        (apply dom/div nil
+          (map-indexed repo-button (:repos @app-state)))))))

 ;; {:auth - :repo -}
 (defn repo-config-panel [state owner]
@@ -40,8 +43,14 @@
         (merge state {:mutable mutable
                       :state-cursor (:state (om/root-cursor mutable))})))

+    om/IWillMount
+    (will-mount [_]
+      (prn "repo panel mount"))
+
     om/IRenderState
     (render-state [this state]
+      (prn "repo panel render")
+
       (let [cursor (om/ref-cursor (:state-cursor state))
             current-state (nth (om/observe owner cursor) 0)
             auth-token (:auth state)
@@ -68,14 +77,10 @@
 ;; {:repos - :auth -}
 (defn repo-detail-view [state owner]
   (reify
-    om/IInitState
-    (init-state [_]
-      state)
-
-    om/IRenderState
-    (render-state [this state]
+    om/IRender
+    (render [this]
       (let [current-index (nth (om/observe owner (current-index-cur)) 0)
-            repos (:repos state)]
+            repos (:repos @app-state)]
         (if (< current-index (count repos))
           (om/build repo-config-panel {:repo (nth repos current-index)
                                        :auth (:auth state)})
@@ -85,16 +90,21 @@
   (reify
     om/IInitState
     (init-state [_]
-      {:me (js->clj (json/parse (.-cloc_me js/window)))
-       :auth (.get (Cookies. js/document) "session_id")})
+      {:auth (.get (Cookies. js/document) "session_id")})
+
+    om/IWillMount
+    (will-mount [_]
+      (let [me (js->clj (json/parse (.-cloc_me js/window)))
+            repos (or (vec (get me "repos")) [])]
+        (swap! app-state (fn [state] (assoc state :repos repos)))))

     om/IRenderState
     (render-state [this state]
-      (let [repos (vec (get-in state [:me "repos"]))]
-        (prn repos)
+      (let [repo-ref (om/ref-cursor (:repos (om/root-cursor app-state)))]
         (dom/div nil
-          (om/build repo-list-view repos)
-          (om/build repo-detail-view {:repos repos
-                                      :auth (:auth state)}))))))
+          (om/build repo-list-view nil)
+          (om/build repo-detail-view {:repos-ref repo-ref
+                                      :index-ref (om/ref-cursor (:current-index (om/root-cursor app-state)))
+                                      :auth (:auth state)}))))))

 (om/root widget app-state {:target (.getElementById js/document "content")})


repo-list-view

repo-list-view

--- cloc-webapp/src-cljs/dash/dash.cljs
+++ cloc-webapp/src-cljs/dash/dash.cljs
@@ -6,4 +6,21 @@
             [om.dom :as dom :include-macros true]
             [cljs-http.client :as http]))

-(def app-state (atom {}))+(def app-state (atom {}))
+
+;; left panel to list all the repos
+(defn repo-list-view [state owner]
+  (reify
+    om/IDidMount
+    (did-mount [this]
+      (go (let [resp (<! (http/get "http://localhost:4679/users/repos" {:oauth-token (om/get-state this :auth)}))
+                repos (:body resp)]
+            (when repos
+              (om/set-state! this :repos repo)))))
+
+    om/IRenderState
+    (render-state [this state]
+      (if (:repos state)
+        (apply dom/ul nil
+          (map (fn [repo] (dom/li nil (:full_name repo))) (:repos this)))))))
+


CMR-2306 fixes test

CMR-2306 fixes test

--- common-lib/src/cmr/common/config.clj
+++ common-lib/src/cmr/common/config.clj
@@ -223,7 +223,7 @@
    (let [known-env-vars (for [[_ sub-map] @configs-atom
                               [config-key _] sub-map]
                           (config-name->env-name config-key))
-         cmr-env-vars (filter #(.startsWith ^String (name %) "cmr-")
+         cmr-env-vars (filter #(.startsWith ^String % "CMR_")
                               (keys env-var-map))
          unknown-vars (set/difference (set cmr-env-vars) (set known-env-vars))]
      (if (seq unknown-vars)


Some extra play fun

Some extra play fun

--- src/polismath/play.clj
+++ src/polismath/play.clj
@@ -6,6 +6,7 @@
         clojure.pprint
         criterium.core
         polismath.conversation
+        polismath.clusters
         polismath.pca
         polismath.utils
         polismath.named-matrix
@@ -19,8 +20,6 @@

 (def conv {:rating-mat nmat})

-(def small-conv-update (graph/eager-compile small-conv-update-graph))
-
 (def results (small-conv-update {:conv conv :opts {}
                              :votes [
                                      {:pid 'a :tid 'x :vote 1}
@@ -28,7 +27,15 @@
                                      {:pid 'd :tid 'y :vote 1}
                                      ]}))

+(def results2 (small-conv-update {:conv results :opts {}
+                             :votes [
+                                     {:pid 'a :tid 'q :vote -1}
+                                     {:pid 'd :tid 'q :vote 0}
+                                     {:pid 'd :tid 'x :vote -1}
+                                     ]}))
+
 (pprint results)
+(pprint results2)

 (defn -main []
   (println "Running main"))