DSL syntax is changed a little.

DSL syntax is changed a little.

--- src/sweet_crossplane/core.clj
+++ src/sweet_crossplane/core.clj
@@ -192,9 +192,9 @@

 (defn sort-keyfn-and-comp
   [entity-class-key]
-  (let [[keyfn comp] (get-in (entity-class-schema entity-class-key) [:list :sort-by])]
-    [(or keyfn (first (list-property-keys entity-class-key)))
-     (or comp  compare)]))
+  (let [{:keys [key comp]} (get-in (entity-class-schema entity-class-key) [:list :sort-by])]
+    [(or key  (first (list-property-keys entity-class-key)))
+     (or comp compare)]))

 (defn property-schema
   [entity-class-key property-key]
@@ -831,16 +831,16 @@
                                          database
                                          (input-property-keys entity-class-key)))
         entity-errors       (or (and (not-empty (get-in *request* [:entity-param-errors])) {})
-                                (let [database (if-let [before-validate-fn (:before-validate-fn entity-class-schema)]
-                                                 (before-validate-fn database entity-class-key entity-key)
+                                (let [database (if-let [before-validate (:before-validate entity-class-schema)]
+                                                 (before-validate database entity-class-key entity-key)
                                                  database)]
                                   (or (not-empty (get-in (radial-mount/validate @database-schema database) [entity-class-key entity-key]))
                                       (try
                                         (save! @database-schema database *transaction*)
                                         nil
                                         (catch SQLException ex
-                                          (or (if-let [sql-exception-catch-fn (:sql-exception-catch-fn entity-class-schema)]
-                                                (sql-exception-catch-fn ex))
+                                          (or (if-let [sql-exception-catch (:sql-exception-catch entity-class-schema)]
+                                                (sql-exception-catch ex))
                                               (throw ex)))))))]
     (if entity-errors
       (new-or-edit-view-fn entity-class-key (get-in database [entity-class-key entity-key]) entity-errors)


manually set the classloader system property to match clojure's classpath

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -44,18 +44,32 @@
                      (require 'clojure.main)))
     cl))

+(defn set-classpath!
+  "Set the JVM classpath property to the current clojure classloader."
+  [classloader]
+  (System/setProperty "java.class.path"
+                      (join ":" (for [url (.getURLs classloader)]
+                                  (let [path (.getPath url)]
+                                    (if (.endsWith path "/")
+                                      (.substring path 0 (- (count path) 1))
+                                      path))))))
+
 (defn reload! []
   (alter-var-root #'classloader
     (fn [cl]
       (when cl (eval-in cl '(shutdown-agents)))
-      (make-classloader))))
+      (let [classloader (make-classloader)]
+        (set-classpath! classloader)
+        classloader))))

 (defn reload []
   (alter-var-root #'classloader
     (fn [cl]
       (if cl
         (do (eval-in cl '(bake.reload/reload)) cl)
-        (make-classloader)))))
+        (let [classloader (make-classloader)]
+          (set-classpath! classloader)
+          classloader)))))

 (defn- quote-if
   "We need to quote the binding keys so they are not evaluated within the bake


Checkout as fast as possible (except possibly the tar.gz download from github).

--- src/circle/proto.clj
+++ src/circle/proto.clj
@@ -19,6 +19,54 @@
 (defn env-paths
   []
   (string/split (System/getenv "PATH") #":"))
+
+
+;;;  How can we quickly get a clone that we can experiment on? A full
+;;;  clone includes full history, file data, and remote branches. In
+;;;  the best case, we want no history, no remote branches, and
+;;;  possibly even no file data (ie, just directory listings).
+
+
+;;; SVN
+;;;   - Bare checkout, no history
+;;;     $ svn export
+;;;
+;;;
+;;; Git:
+;;;   - Full clone, using git protocol (41s)
+;;;     $ git clone git@github.com:coffeemug/rethinkdb.git
+;;;     - 41s
+;;;
+;;;   - Full clone, using http protocol (50s ish)
+;;;     $ git clone https://github.com/coffeemug/rethinkdb/
+;;;
+;;;   - Shallow clone using remote git archive
+;;;     $ git archive --remote=url url
+;;;     - Not supported on all git hosts, including github
+;;;
+;;;   - Shallow git clone with depth (17s)
+;;;     $ git clone --depth=1 git@github.co:coffeemug/rethinkdb.git
+;;;
+;;;   - Download a tarball directly
+;;;     $ wget https://nodeload.github.com/coffeemug/rethinkdb/tarball/master.tar.gz
+;;;     - awkward, since you need to authenticate first using cookies
+;;;     - github only
+;;;
+;;;   - Fetch only one branch, shallowly (8s)
+;;;     $ mkdir rethinkdn
+;;;     $ cd rethinkdb
+;;;     $ git init
+;;;     $ git remote add origin git@github.com:pbiggar/rethinkdb.git
+;;;     $ git fetch origin HEAD
+;;;     - this will work pretty much anywhere
+;;;
+;;;   - Might be faster still, see super-advanced possibilities:
+;;;     - http://progit.org/book/ch9-6.html
+;;;     - http://stackoverflow.com/questions/1178389/
+;;;
+;;; hg:
+;;;   - wget http://hg.mozilla.org/mozilla-central/archives/tip.tar.bz2
+;;;     Tarball with no history

 (defn autoconf
@@ -90,23 +138,19 @@
   (let [parsed (re-find #"^git@github.com:(\w+)/(\w+)\.git$" url)]
     (when parsed
       (let [[_ username project] parsed
-            dir "scratch/"
-            tar-file (fs/join dir "master.tar.gz")]
-        (download (str "https://nodeload.github.com/" username "/" project "/tarball/master")
-                  tar-file)
-        (untar tar-file dir)
-        {:srcdir (fs/join dir (tar-get-directory tar-file))}))))
+            dir (fs/join "scratch" project)]
+        (shell-out "mkdir" "-p" dir)
+        (shell-out "git" "init" :dir dir)
+        (shell-out "git" "remote" "add" "origin" url :dir dir)
+        (shell-out "git" "fetch" "origin" "HEAD" "--depth" "1" :dir dir)
+        {:srcdir dir}))))

 (defn repo-handler
   [{:keys [repo subdir] :or {subdir ""}}]
   ; if they dont match, return non-nil and try the next one. If they
   ; do match, return the directory the code was checked out into on
   ; success, and raise an exception on failure.
-  (some (try-github repo)
-;        (try-git)
-        (try-hg repo)
-;        (try-svn)
-        ))
+  (some #(% repo) [try-github try-hg]))

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


whitespace

whitespace

--- src/client/chat.cljs
+++ src/client/chat.cljs
@@ -1,7 +1,7 @@
 (ns client.chat
-	(:require-macros [hiccups.core :as hiccups])
+  (:require-macros [hiccups.core :as hiccups])
   (:require
-		hiccups.runtime
+    hiccups.runtime
     [client.socket :refer [socket]]
     [client.login :refer [get-username
                           get-color]]
@@ -13,7 +13,7 @@
 ;;------------------------------------------------------------

 (hiccups/defhtml chat-html []
-	[:div#inner-container
+  [:div#inner-container
     [:div.chat-logo-e38e3
       [:img {:src "/img/t3tr0s_logo_200w.png" :width "160px"}]
       [:span.span-4e536.time-left-8a651 "Waiting to play..."]]
@@ -25,18 +25,18 @@
 (hiccups/defhtml chat-msg-html
   [{:keys [user color msg]}]
   [:p.message
-   [:span#user {:class (str "color-" color)}(str user ": ")]
-   [:span.txt msg]])
+    [:span#user {:class (str "color-" color)}(str user ": ")]
+    [:span.txt msg]])

 (hiccups/defhtml chat-join-html
   [{:keys [user color]}]
   [:p.message
-   [:span#user {:class (str "color-" color)}(str user " joined the lobby")]])
+    [:span#user {:class (str "color-" color)}(str user " joined the lobby")]])

 (hiccups/defhtml chat-leave-html
   [{:keys [user color]}]
   [:p.message
-   [:span#user {:class (str "color-" color)}(str user " left the lobby")]])
+    [:span#user {:class (str "color-" color)}(str user " left the lobby")]])

 ; alias the jquery variable


Garbage collection fun. Might be a bad idea to do this here...

--- src/clojure/core.clj
+++ src/clojure/core.clj
@@ -226,6 +226,11 @@

                              ;;TODO
                              ;;(xtract/xtract_tonality      wav-data block-size (xtract-args ) tonality)
+
+                             ;;TODO: Correct to clean these here?
+                             (xtract/delete_double_array wav-data)
+                             (xtract/delete_double_array spectrum)
+                             (xtract/delete_double_array peaks)

                              {(* idx (int SAMPLE_RATE))
                               {:spectral-inharmonicity spectral-inharmonicity


CM & GR - Add test for adding user to session

--- test/d_cent/workflows/twitter_test.clj
+++ test/d_cent/workflows/twitter_test.clj
@@ -17,3 +17,9 @@
       (twitter-login fake-request) => (contains {:status 502})
       (provided
         (oauth/request-token consumer callback-url) => nil))
+
+(fact "Sets session username to twitter screen name"
+      (let [params {:oauth_verifier "verifier"}]
+        (twitter-callback {:params params}) => (contains {:session {:cemerick.friend/identity {:authentications {"screen name" {:identity "screen name", :username "screen name"}}, :current "screen name"}}})
+        (provided
+          (oauth/access-token consumer params "verifier") => {:screen_name "screen name"})) )


Check for invalid job metadata - git repository

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -488,6 +488,9 @@
 (def create-job-postdata-invalid-metadata-1
     "{\"ssh_url_to_repo\":\"https://url-to-repo.git\", \"branch\":\"master\"}")

+(def create-job-postdata-invalid-metadata-2
+    "{\"name\":\"test-Test_Product-1.0-Test_Book-en-US (preview)\", \"branch\":\"master\"}")
+
 (def default-request
     {:configuration
         {:jobs
@@ -552,6 +555,20 @@
                                                            :headers {"Content-Type" "application/json"}
                                                            :body "{\"status\":\"error\",\"command\":\"create_job\",\"message\":\"invalid or missing input\"}"})))))

+(deftest test-create-job-invalid-metadata-2
+    "Check the function emender-jenkins.rest-api/create-job."
+    (testing "the function emender-jenkins.rest-api/create-job."
+        (with-redefs [jenkins-api/create-job (fn [jenkins-url jenkins-auth include-jenkins-reply? job-name git-repo branch credentials-id metadata-directory metadata]
+                                                 (jenkins-api/ok-response-structure job-name "create_job" include-jenkins-reply? "created"))
+                      jenkins-api/start-job  (fn [jenkins-url jenkins-auth include-jenkins-reply? job-name]
+                                                 (jenkins-api/ok-response-structure job-name "build" include-jenkins-reply? "added to queue"))
+                      read-request-body      (fn [request] create-job-postdata-invalid-metadata-2)
+                      reload-job-list        (fn [response request] response)
+                      send-response          (fn [response request] response)]
+                      (is (= (create-job default-request) {:status  400
+                                                           :headers {"Content-Type" "application/json"}
+                                                           :body "{\"status\":\"error\",\"command\":\"create_job\",\"message\":\"invalid input: git repo not specified\"}"})))))
+
 (deftest test-create-job-NPE
     "Check the function emender-jenkins.rest-api/create-job."
     (testing "the function emender-jenkins.rest-api/create-job."


Test for function send-plain-response

Test for function send-plain-response

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -1010,3 +1010,15 @@
                      :headers {"Content-Type" "application/json"}
                      :body    "{\"response\":{\"deep\":{\"structure\":\"ok\"}}}\n"})))))

+(deftest test-send-plain-response
+    "Check the function emender-jenkins.rest-api/send-plain-response."
+    (testing "the function emender-jenkins.rest-api/send-plain-response."
+         (is (= (send-plain-response {:response :error})
+                {:status  200
+                 :headers {"Content-Type" "application/json"}
+                 :body    {:response :error}}))
+         (is (= (send-plain-response {:response {:deep {:structure :error}}})
+                {:status  200
+                 :headers {"Content-Type" "application/json"}
+                 :body    {:response {:deep {:structure :error}}}}))))
+


Updated formatting

Updated formatting

--- test/midje/emission/plugins/t_util.clj
+++ test/midje/emission/plugins/t_util.clj
@@ -39,4 +39,4 @@
   => (just #"FAIL\S* at \(filename:10\)"
            "With table substitutions: a big string")
   (failure-notice {:position ["filename" 10] :namespace "example.ns.file"})
-  => (just #"FAIL\S* at \(filename:10 example.ns.file\)" nil))
+  => (just #"FAIL\S* at \(filename:10  example.ns.file\)" nil))


✅ Fix test failing with the wrong error

✅ Fix test failing with the wrong error

Why:
- If the role has permission to write to public schema, then the test
  fails with "No results were returned by the query." which masks the
  real cause of test failure

--- test/territory_bro/gis/gis_db_test.clj
+++ test/territory_bro/gis/gis_db_test.clj
@@ -493,7 +493,7 @@

     (testing "cannot create objects in the public schema"
       (is (thrown-with-msg? PSQLException #"ERROR: permission denied for schema public"
-                            (jdbc/query db-spec ["create table public.foo (id serial primary key)"]))))
+                            (jdbc/execute! db-spec ["create table public.foo (id serial primary key)"]))))

     (testing "cannot login to database after user is deleted"
       (db/with-db [conn {}]


Remove redundant code

Remove redundant code

--- test/yada/collection_resource_test.clj
+++ test/yada/collection_resource_test.clj
@@ -42,13 +42,3 @@
                            {:headers {"if-modified-since" (format-date (to-date (time/now)))}})
             response @(handler request)]
         (is (= 304 (:status response)))))))
-
-
-(let [test-map {:name "Frank"}
-      handler (time/do-at (yesterday) (handler (as-resource test-map)))
-      request (mock/request :get "/")
-      response @(handler request)
-      ]
-  response
-
-  )


change to find all matches, serves as a better example

--- src/kmp_search/core.clj
+++ src/kmp_search/core.clj
@@ -53,14 +53,29 @@
   (Context. pattern))

 (defn search-file
-  "returns the index of the first occurreence of a byte pattern in a
-  file or nil if the pattern is not present."
+  "returns a vector containing all the offsets where a byte pattern
+  appears within a file"
   [^bytes pattern file & {:keys [buffer-size] :or {buffer-size 1024}}]
   (let [buffer (byte-array buffer-size)]
     (with-open [ins (io/input-stream file)]
-      (loop [c (context pattern)
-             read-count (.read ins buffer)]
-        (if-not (neg? read-count)
-          (let [c (search c buffer read-count)]
-            (or (match c)
-                (recur c (.read ins buffer)))))))))
+      (loop [context (context pattern)
+             read-count (.read ins buffer)
+             matches []]
+        (if (neg? read-count)
+          matches
+          (let [new-context (search context buffer read-count)
+                match (match new-context)]
+            (if match
+              (recur new-context read-count (conj matches match))
+              (recur new-context (.read ins buffer) matches))))))))
+
+;; > (search-file (.getBytes "local") "/etc/hosts")
+;; [10 113 148]
+;; > (search-file (.getBytes "local") "/etc/hosts" :buffer-size 1)
+;; [10 113 148]
+;; > (search-file (.getBytes "local") "/etc/hosts" :buffer-size 2)
+;; [10 113 148]
+;; > (search-file (.getBytes "local") "/etc/hosts" :buffer-size 3)
+;; [10 113 148]
+;; > (search-file (.getBytes "local") "/etc/hosts" :buffer-size 71)
+;; [10 113 148]


Added renaming funstructor.game-state

Added renaming funstructor.game-state

--- src/clj/funstructor/commands.clj
+++ src/clj/funstructor/commands.clj
@@ -2,7 +2,7 @@
   (:require [cheshire.core :refer [generate-string parse-string]]
             [clojure.core.async :refer [>! <! go go-loop timeout]]

-            [funstructor.game-state :refer :all]
+            [funstructor.game-state :as gs]
             [funstructor.cards :as cards]
             [funstructor.cards-functions :as f]
             [funstructor.utils :as u]))
@@ -27,9 +27,9 @@
 (defn pending-checker []
   (go-loop []
     (<! (timeout 3000))
-    (when-let [pending-pair (get-pending-pair (current-global-state))]
+    (when-let [pending-pair (gs/get-pending-pair (gs/current-global-state))]
       (let [[uuid1 uuid2] pending-pair
-            [channel1 channel2] (map #(channel-for-uuid (current-global-state) %) pending-pair)
+            [channel1 channel2] (map #(gs/channel-for-uuid (gs/current-global-state) %) pending-pair)
             game-id (u/gen-uuid)]
         (u/log "Taking two players for game " game-id " with uuids: " pending-pair "\n\n")
         (send-command {:type :start-game
@@ -41,8 +41,8 @@
                                :enemy uuid1}}
                        channel2)

-        (update-global-state add-game game-id (f/make-game uuid1 uuid2))
-        (update-global-state #(apply remove-from-pending % pending-pair))))
+        (gs/update-global-state gs/add-game game-id (f/make-game uuid1 uuid2))
+        (gs/update-global-state #(apply gs/remove-from-pending % pending-pair))))
     (recur)))

 (defn make-update-data [game-state player-uuid]
@@ -57,9 +57,9 @@
         (assoc :enemy-funstruct (:funstruct (f/get-player-state game-state opponent-uuid))))))

 (defn send-game-updates [game-id]
-  (let [initialized-game (get-game (current-global-state) game-id)
+  (let [initialized-game (gs/get-game (gs/current-global-state) game-id)
         [p1 p2 :as players] (f/get-game-players initialized-game)
-        [c1 c2] (map #(channel-for-uuid (current-global-state) %) players)]
+        [c1 c2] (map #(gs/channel-for-uuid (gs/current-global-state) %) players)]
     (u/log "Sending game-update's for game " game-id)
     (send-command {:type :game-update
                     :data (make-update-data initialized-game p1)
@@ -77,47 +77,52 @@

 (defmethod handle-command "game-request" [command channel]
   (let [uuid (u/gen-uuid)]
-    (update-global-state (comp #(add-channel % channel uuid)
-                               #(add-pending % uuid)))
+    (gs/update-global-state (comp #(gs/add-channel % channel uuid)
+                                  #(gs/add-pending % uuid)))
     (u/log "Processing game-request and generating uuid: " uuid)
     (send-command {:type :game-request-ok
-                    :data {:uuid uuid
-                           :pending (get-pending-players (current-global-state))}}
-                   channel
-                   )))
+                   :data {:uuid uuid
+                          :pending (gs/get-pending-players (gs/current-global-state))}}
+                  channel
+                  )))

 (defmethod handle-command "start-game-ok" [command channel]
   (let [game-id (u/uuid-from-string (get-in command [:data :game-id]))
-        game (get-game (current-global-state) game-id)
-        player-id (uuid-for-channel (current-global-state) channel)
+        game (gs/get-game (gs/current-global-state) game-id)
+        player-id (gs/uuid-for-channel (gs/current-global-state) channel)
         ]
     (u/log "Processing start-game-ok for game: " game-id
            "\n\n")
-    (update-global-state update-game game-id f/mark-player-ready player-id)
-    (when (f/both-players-ready (get-game (current-global-state) game-id))
-      (update-global-state update-game game-id f/init-game)
+    (gs/update-global-state gs/update-game game-id f/mark-player-ready player-id)
+    (when (f/both-players-ready (gs/get-game (gs/current-global-state) game-id))
+      (gs/update-global-state gs/update-game game-id f/init-game)
       (send-game-updates game-id))))

 (defmethod handle-command "action" [command channel]
   (let [game-id (u/uuid-from-string (get-in command [:data :game-id]))
-        player-id (uuid-for-channel (current-global-state) channel)
+        player-id (gs/uuid-for-channel (gs/current-global-state) channel)
         card-idx (get-in command [:data :card-idx])
         target (get-in command [:data :target])
         funstr-idx (get-in command [:data :funstruct-idx])]
-    (update-global-state update-game game-id f/use-card player-id card-idx funstr-idx)
+    (gs/update-global-state gs/update-game game-id f/use-card player-id card-idx funstr-idx)
     (send-game-updates game-id)))

 (defmethod handle-command "end-turn" [command channel]
   (let [game-id (u/uuid-from-string (get-in command [:data :game-id]))
-        player-id (uuid-for-channel (current-global-state) channel)]
+        player-id (gs/uuid-for-channel (gs/current-global-state) channel)]

     (u/log "Processing end-turn for game: " game-id)

-    (update-global-state update-game game-id f/end-turn-for-player)
-    (let [updated-game (get-game (current-global-state) game-id)]
+    (gs/update-global-state gs/update-game game-id f/end-turn-for-player)
+    (let [updated-game (gs/get-game (gs/current-global-state) game-id)]
       (when (f/turn-finished? updated-game)
-        (update-global-state update-game game-id f/end-turn)
+        (gs/update-global-state gs/update-game game-id f/end-turn)
         (send-game-updates game-id)))))
+
+(defmethod handle-command "chat-message" [command channel]
+  (let [game-id (u/uuid-from-string (get-in command [:data :game-id]))
+        player-id (gs/uuid-for-channel (gs/current-global-state) channel)]
+    ))

 (defmethod handle-command :default [command channel]
   (u/printerr "Unrecognized command: " command))


implement Dr. Lovegood

implement Dr. Lovegood

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -103,6 +103,19 @@
    "Decoy"
    {:prevent {:tag [:all]}
     :abilities [{:msg "avoid 1 tag" :effect (effect (tag-prevent 1) (trash card {:cause :ability-cost}))}]}
+
+   "Dr. Lovegood"
+   {:abilities [{:prompt "Choose an installed card to make its text box blank for the remainder of the turn" :once :per-turn
+                 :choices {:req #(:installed %)}
+                 :msg (msg "make the text box of " (:title target) " blank for the remainder of the turn")
+                 :effect (req (let [c target]
+                                (update! state side (dissoc target :events :abilities))
+                                (desactivate state side target)
+                                (register-events state side
+                                                 {:runner-turn-ends
+                                                  {:effect (effect (card-init (get-card state c) false)
+                                                                   (unregister-events card))}} card)))}]
+    :events {:runner-turn-ends nil}}

    "Drug Dealer"
    {:events {:corp-turn-begins {:msg "draw 1 card" :effect (effect (draw :runner 1))}


Fix swapped parameter names in board/piece-count.

--- src/clojure/clj_chess/board.cljc
+++ src/clojure/clj_chess/board.cljc
@@ -236,7 +236,7 @@
      a board and a piece as input, and a three-argument version taking a board,
      a color and a piece type."
      ([board piece] (.pieceCount board piece))
-     ([board type color] (.pieceCount board type color))))
+     ([board color type] (.pieceCount board color type))))

 (defn parent
   "The parent board of the current board (i.e. the board as it was before the


Hide hints when window comes into focus

Hide hints when window comes into focus

--- src/clojure/nightcode/window.clj
+++ src/clojure/nightcode/window.clj
@@ -2,6 +2,7 @@
   (:require [nightcode.cli-args :as cli-args]
             [nightcode.dialogs :as dialogs]
             [nightcode.editors :as editors]
+            [nightcode.shortcuts :as shortcuts]
             [nightcode.ui :as ui]
             [seesaw.core :as s])
   (:import [java.awt Window]
@@ -49,7 +50,8 @@
   (.addWindowListener window
     (proxy [WindowAdapter] []
       (windowActivated [e]
-        (ui/update-project-tree!))
+        (ui/update-project-tree!)
+        (shortcuts/toggle-hints! @ui/root false))
       (windowClosing [e]
         (confirm-exit-app!)))))


Keep file selected after toggling away from the files view

--- src/clojure/nightmod/screens.clj
+++ src/clojure/nightmod/screens.clj
@@ -95,10 +95,10 @@

 (defn toggle-files!
   []
-  (when (.exists (io/file @ui/tree-selection))
-    (u/toggle-glass!))
-  (s/invoke-now
-    (reset! ui/tree-selection @u/project-dir)))
+  (if (.exists (io/file @ui/tree-selection))
+    (u/toggle-glass!)
+    (s/invoke-now
+      (reset! ui/tree-selection @u/project-dir))))

 (defn toggle-docs!
   []


improved translation functions

improved translation functions

--- src/mastersign/geom.clj
+++ src/mastersign/geom.clj
@@ -34,13 +34,19 @@
     a))))

 (defn translate-point
-  [p x y]
-  (point (+ (.x p) x) (+ (.y p) y)))
+  ([p o]
+   (translate-point p (.x o) (.y o)))
+  ([p x y]
+   (point (+ (.x p) x) (+ (.y p) y))))

 (defn translate-rect
-  [r x y]
-  (rectangle (+ (.x r) x) (+ (.y r) y) (.width r) (.height r)))
+  ([r o]
+   (translate-rect r (.x o) (.y o)))
+  ([r x y]
+   (rectangle (+ (.x r) x) (+ (.y r) y) (.width r) (.height r))))

 (defn translate-ellipse
-  [e x y]
-  (ellipse (+ (.x e) x) (+ (.y e) y) (.width e) (.height e)))+  ([e o]
+   (translate-ellipse e (.x o) (.y o)))
+  ([e x y]
+   (ellipse (+ (.x e) x) (+ (.y e) y) (.width e) (.height e))))


Move Custard states into a single atom, unify loading states

--- src/custard/core.clj
+++ src/custard/core.clj
@@ -20,11 +20,11 @@

 (defprotocol ICustard
   (states [this])
-  (state [this id]))
+  (state [this name]))

 ;;;; State representation

-(defrecord State [id name type graph load-file-fn]
+(defrecord State [name revision type graph load-file-fn]
   IState
   (project [this]
     (first (into []
@@ -57,57 +57,52 @@
 ;;;; The uncommitted state (working directory)

 (defn uncommitted-state [dir]
-  (let [graph (parse-uncommitted dir)]
-    (State. "UNCOMMITTED"
-            "UNCOMMITTED"
-            :none
-            graph
-            #(load-file-from-dir dir %))))
+  (map->State {:name "UNCOMMITTED"
+               :revision (new java.util.Date)
+               :type :none
+               :graph (parse-uncommitted dir)
+               :load-file-fn #(load-file-from-dir dir %)}))

 ;;;; Branch and tag states

 (defn ref-states [repo]
   (let [refs (git-ref/load-all repo)]
     (mapv (fn [ref]
-            (State. (:name ref)
-                    (:name ref)
-                    (:type ref)
-                    (if (:head ref)
-                      (parse-commit repo (:head ref))
-                      [])
-                    #(load-file-from-commit repo (:head ref) %)))
+            (map->State {:name (:name ref)
+                         :revision (:sha1 (:head ref))
+                         :type (:type ref)
+                         :graph (if (:head ref)
+                                  (parse-commit repo (:head ref))
+                                  [])
+                         :load-file-fn
+                         #(load-file-from-commit repo (:head ref) %)}))
           refs)))

 ;;;; Default Custard implementation

-(defrecord Custard [dir repo watcher refs uncommitted]
+(defrecord Custard [dir repo watcher states-map]
   ICustard
   (states [this]
-    (if @uncommitted
-      (into [@uncommitted] @refs)
-      @refs))
+    (into [] (vals @states-map)))

-  (state [this id]
-    (if (= id "UNCOMMITTED")
-      @uncommitted
-      (first (filter #(= id (:id %)) (states this)))))
+  (state [this name]
+    (@states-map name))

   component/Lifecycle
   (start [this]
     (let [repo (git-repo/load dir)
           bare? (.isBare (.getRepository repo))]
-      (when-not bare?
-        (reset! uncommitted (uncommitted-state dir)))
-      (reset! refs (ref-states repo))
-      (-> this
-          (assoc :repo repo)
-          (assoc :watcher
-                 (watch-dir (fn [_]
-                              (when-not bare?
-                                (reset! uncommitted
-                                        (uncommitted-state dir)))
-                              (reset! refs (ref-states repo)))
-                            dir)))))
+      (letfn [(reload-states []
+                (let [states (if-not bare?
+                               {"UNCOMMITTED" (uncommitted-state dir)}
+                               {})]
+                  (reset! states-map (into states
+                                           (map #(vector (:name %) %))
+                                           (ref-states repo)))))]
+        (reload-states)
+        (-> this
+            (assoc :repo repo)
+            (assoc :watcher (watch-dir (fn [_] (reload-states)) dir))))))

   (stop [this]
     (when watcher
@@ -121,5 +116,4 @@
   (map->Custard {:dir (fs/file path)
                  :repo nil
                  :watcher nil
-                 :refs (atom [])
-                 :uncommitted (atom nil)}))
+                 :states-map (atom {})}))


basic cmd works

basic cmd works

--- src/bolt/core.cljs
+++ src/bolt/core.cljs
@@ -4,6 +4,7 @@
               [cljs.core.async :refer [put! <! >! chan timeout]]
               [om.core :as om :include-macros true]
               [om.dom :as dom :include-macros true]
+              [clojure.string :as string]
               [bolt.config :as config]))

 ;; Lets you do (prn "stuff") to the console
@@ -20,7 +21,8 @@

 (defn search-form [app owner {:keys [chan]}]
   (om/component
-   (dom/form #js {:onSubmit #(submit-search chan %) }
+   (dom/form #js {:onSubmit #(submit-search chan %)
+                  :className "jumbotron"}
             (dom/input #js {:type "text" :id "search_term"})
             (dom/input #js {:type "submit" :value "Search"}))))

@@ -46,44 +48,67 @@
   (put! chan [:service.id id])
   false)

-(defn search-results [app owner {:keys [result chan]}]
+(defn search-results [app owner {:keys [chan]}]
   (om/component
    (dom/div
     #js {:id "search_results"}
-    (if result
+    (if-let [result (:search-result app)]
       (do (.log js/console "DATA" result)
           (render-table ["h1" "h2"] [["c1" "c2"] ["d1" "d2"]]))
       ""))))

+(defn process-search
+  "For now this is just a local config lookup but this could interact
+  with another service."
+  [input]
+  (let [[cmd & args] (string/split input #"\s+")]
+    {:name cmd
+     :url (get-in config/config [:commands (keyword cmd)])
+     :args args}))
+
 (defn handle-event [app event event-data {:keys [chan]}]
-  (.log js/console "Event: " (pr-str event) event-data)
+  (.log js/console "Event: " (pr-str event event-data))
   (case event
-    :service.search (put! chan [:ui.search (get-in config/config [:commands (keyword event-data)])])
+    :service.search (put! chan [:ui.search (process-search event-data)])
     :ui.search  (om/update! app assoc :search-result event-data)
     (.log js/console "No event found for" event event-data)))

+(defn handle-search-result [app opts]
+  (let [{:keys [url] :as cmd} (:search-result app)]
+    (if url
+      ;; TODO: url encode args
+      ;; TODO: error for non-matching args
+      (let [redirect-url (apply string/replace url "%s" (:args cmd))]
+        (prn js/console redirect-url)
+        (set! (.-location js/window) redirect-url))
+      (do
+        (om/update! app assoc :error (str "No command found for " (:name cmd)))
+        nil))))
+
 (defn bolt-app [app owner]
   (reify
-      om/IWillMount
-      (will-mount [_]
-                  (let [main-chan (chan 10)]
-                    (om/set-state! owner :chan main-chan)
-                    (go (while true
-                          (let [[event event-data](<! main-chan)]
-                            (handle-event
-                             app
-                             event
-                             event-data
-                             {:chan main-chan}))))
-                    (put! main-chan [:ui.search "found"])))
-      om/IRender
-      (render [_]
-              (dom/div nil
-                       (dom/h1 nil "Welcome to Bolt!")
-                       (om/build search-form app {:opts {:chan (om/get-state owner :chan)}})
-                       ;; Consider not rendering these when they have no results
-                       (om/build search-results app {:opts {:result (:search-result app)
-                                                            :chan (om/get-state owner :chan)}})
-                       ))))
+    om/IWillMount
+    (will-mount [_]
+      (let [main-chan (chan 10)]
+        (om/set-state! owner :chan main-chan)
+        (go (while true
+              (let [[event event-data](<! main-chan)]
+                (handle-event
+                  app
+                  event
+                  event-data
+                  {:chan main-chan}))))))
+    om/IRender
+    (render [_]
+      (dom/div nil
+               (dom/h1 nil "Welcome to Bolt!")
+               (when (:error app)
+                 (dom/div
+                   #js {:className "alert alert-danger"}
+                   nil
+                   (:error app)))
+               (om/build search-form app {:opts {:chan (om/get-state owner :chan)}})
+               (when (:search-result app)
+                 (handle-search-result app {:chan (om/get-state owner :chan)}))))))

 (om/root app-state bolt-app (.getElementById js/document "app"))


Handle flushing writes to patch tablet!

Handle flushing writes to patch tablet!

--- src/merkle_db/table.clj
+++ src/merkle_db/table.clj
@@ -392,50 +392,6 @@
   "Return true if the table has local non-persisted modifications."
   [^Table table]
   (.dirty table))
-
-
-(defn- -flush!
-  "Ensure that all local state has been persisted to the storage backend and
-  return an updated non-dirty table."
-  ([table]
-   (-flush! table false))
-  ([^Table table apply-patches?]
-   (if (dirty? table)
-     (let [[patch-link data-link]
-             (if (or (seq (.pending table)) (::patch table))
-               (if apply-patches?
-                 ; Combine pending changes and patch tablet and update data tree.
-                 [nil (throw (UnsupportedOperationException. "NYI: merge pending changes and patch tablet into data tree"))]
-                 ; flush any pending changes to the patch tablet
-                 ; if patch tablet overflows, update main data tree
-                 (throw (UnsupportedOperationException. "NYI: flush pending changes to patch tablet, overflow to data tree")))
-               ; No patch data or tablet.
-               [nil (::data table)])
-           root-data (-> (.root-data table)
-                         (assoc :data/type data-type)
-                         (dissoc ::patch ::data)
-                         (cond->
-                           patch-link (assoc ::patch patch-link)
-                           data-link (assoc ::data data-link)))]
-       (when-not (s/valid? ::node-data root-data)
-         (throw (ex-info (str "Cannot write invalid table root node: "
-                              (s/explain-str ::node-data root-data))
-                         {:type ::invalid-root})))
-       (let [node (mdag/store-node! (.store table) nil root-data)
-             table-info (assoc (.table-info table)
-                               ::node/id (::node/id node)
-                               ::data/size (node/reachable-size node))
-             table-meta (assoc (._meta table)
-                               ::node/links (::node/links node))]
-         (->Table
-           (.store table)
-           table-info
-           (::node/data node)
-           (sorted-map)
-           false
-           table-meta)))
-     ; Table is clean, return directly.
-     table)))

@@ -550,7 +506,7 @@
                            (into {}
                                  (filter (comp some? val))
                                  (merge old-data new-data))))
-         extant (into {} (get-records table (map first records)))
+         extant (into {} (-get-records table (map first records)))
          new-records (map
                        (fn [[k data]]
                          [(key/encode lexicoder k)
@@ -565,7 +521,7 @@
 (defn- -delete
   [table id-keys]
   (let [lexicoder (key/lexicoder (::key/lexicoder table :bytes))
-        extant (get-records table id-keys {:fields {}})]
+        extant (-get-records table id-keys {:fields {}})]
     (-> table
         (update-pending
           into
@@ -576,6 +532,65 @@
         (update ::data/count - (count extant)))))

+(defn- update-index-tree
+  [store link changes]
+  ; TODO: implement
+  (throw (UnsupportedOperationException. "NYI: update data index tree")))
+
+
+(defn- flush-changes
+  "Returns a vector containing a link to a patch tablet and an index tree."
+  [^Table table full?]
+  (let [changes (load-changes table)]
+    (if (seq changes)
+      ; Check for force or limit overflow.
+      (if (or full? (< (::patch/limit table 0) (count changes)))
+        ; Combine pending changes and patch tablet and update data tree.
+        [nil (update-index-tree (.store table) (::data table) changes)]
+        ; Flush any pending changes to the patch tablet.
+        [(->> (patch/from-changes changes)
+              (mdag/store-node! (.store table) nil)
+              (mdag/link "patch"))
+         (::data table)])
+      ; No patch data or tablet.
+      [nil (::data table)])))
+
+
+(defn- -flush!
+  "Ensure that all local state has been persisted to the storage backend and
+  return an updated non-dirty table."
+  ([table]
+   (-flush! table false))
+  ([^Table table apply-patches?]
+   (if (dirty? table)
+     (let [[patch-link data-link] (flush-changes table apply-patches?)
+           root-data (-> (.root-data table)
+                         (assoc :data/type data-type)
+                         (dissoc ::patch ::data)
+                         (cond->
+                           patch-link (assoc ::patch patch-link)
+                           data-link (assoc ::data data-link)))]
+       (when-not (s/valid? ::node-data root-data)
+         (throw (ex-info (str "Cannot write invalid table root node: "
+                              (s/explain-str ::node-data root-data))
+                         {:type ::invalid-root})))
+       (let [node (mdag/store-node! (.store table) nil root-data)
+             table-info (assoc (.table-info table)
+                               ::node/id (::node/id node)
+                               ::data/size (node/reachable-size node))
+             table-meta (assoc (._meta table)
+                               ::node/links (::node/links node))]
+         (->Table
+           (.store table)
+           table-info
+           (::node/data node)
+           (sorted-map)
+           false
+           table-meta)))
+     ; Table is clean, return directly.
+     table)))
+
+
 (extend Table

   ITable


Make alet macro helper functions private

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -225,7 +225,7 @@
                       `(bind ~r (fn [~l] ~acc))))
                   `(do ~@body)))))

-(defn deps [expr syms]
+(defn- deps [expr syms]
   (cond
     (and (symbol? expr)
          (contains? syms expr))
@@ -237,10 +237,10 @@
     :else
     '()))

-(defn rename-sym [expr renames]
+(defn- rename-sym [expr renames]
   (get renames expr expr))

-(defn rename [expr renames]
+(defn- rename [expr renames]
   (cond
     (symbol? expr)
     (rename-sym expr renames)
@@ -249,7 +249,7 @@
     :else
     expr))

-(defn dedupe-symbols*
+(defn- dedupe-symbols*
   [sym->ap body]
   (letfn [(renamer [{:keys [body syms aps seen renames] :as summ} [s ap]]
            (let [ap' (rename ap renames)
@@ -282,14 +282,14 @@
                   sym->ap)]
       [(mapv vector (:syms summ) (:aps summ)) (:body summ)])))

-(defn dedupe-symbols
+(defn- dedupe-symbols
   [bindings body]
   (let [syms (map first bindings)
         aps (map second bindings)
         sym->ap (mapv vector syms aps)]
     (dedupe-symbols* sym->ap body)))

-(defn dependency-map
+(defn- dependency-map
   [sym->ap]
   (let [syms (map first sym->ap)
         symset (set syms)]
@@ -298,13 +298,13 @@
                 :let [ds (set (deps ap symset))]]
             [s ds]))))

-(defn remove-deps
+(defn- remove-deps
   [deps symset]
   (let [removed (for [[s depset] deps]
                   [s (clojure.set/difference depset symset)])]
     (into (empty deps) removed)))

-(defn topo-sort*
+(defn- topo-sort*
   [deps seen batches current]
   (if (empty? deps)
     (conj batches current)
@@ -321,12 +321,12 @@
                (conj batches current)
                [s])))))

-(defn topo-sort
+(defn- topo-sort
   [deps]
   (let [syms (into #{} (map first deps))]
     (topo-sort* deps #{} [] [])))

-(defn bindings->batches
+(defn- bindings->batches
   [bindings]
   (let [syms (map first bindings)
         aps (map second bindings)
@@ -334,7 +334,7 @@
         sorted-deps (topo-sort (dependency-map sym->ap))]
     sorted-deps))

-(defn alet*
+(defn- alet*
   [batches env body]
   (let [fb (first batches)
         rb (rest batches)


Display ch-name in delta animation.

Display ch-name in delta animation.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -87,7 +87,7 @@
                                (dissoc-in [:chs ch :msgs msg])))
                (when (nil? msg) ; The ch is closed.
                  (swap! vis #(dissoc-in % [:chs ch])))
-               [{:delta :take :msg msg :ch ch :actx actx :phase :prev}]))}
+               [{:delta :take :msg msg :ch ch :actx actx :phase :prev :ch-name ch-name}]))}
    :aput
    {:before (fn [vis actx args]
               (let [[ch-name ch msg] args]
@@ -95,7 +95,7 @@
                                 (assoc-in [:actxs actx :wait-chs ch] [:put ch-name])
                                 (vis-add-ch ch nil)
                                 (assoc-in [:chs ch :msgs msg] true)))
-                [{:delta :put :msg msg :actx actx :ch ch :phase :prev}]))
+                [{:delta :put :msg msg :actx actx :ch ch :phase :prev :ch-name ch-name}]))
     :after (fn [vis actx args]
              (let [[ch-name ch msg result] args]
                (swap! vis #(-> %
@@ -232,14 +232,22 @@
                          "<line class='delta' x1='0' y1='0' x2='100' y2='"
                          (- (ch-y (:ch delta)) (actx-y (:actx delta)))
                          "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/>"
-                         "</g>"])
+                         "</g>"
+                         (when (:ch-name delta)
+                           ["<text class='ch-name' x='540' y='"
+                            (* 0.5 (+ (actx-y (:actx delta)) (ch-y (:ch delta))))
+                            "'>" (:ch-name delta) "</text>"])])
                  :take (when (get chs (:ch delta))
                          ["<g transform='translate(600," (ch-y (:ch delta)) ")'>"
                           "<line class='delta' x1='0' y1='0' x2='-100' y2='"
                           (- (actx-y (:actx delta)) (ch-y (:ch delta)))
                           "' stroke='" (if (:msg delta) "green" "black")
                           "' stroke-width='1' marker-end='url(#triangle)'/>"
-                          "</g>"])
+                          "</g>"
+                          (when (:ch-name delta)
+                            ["<text class='ch-name' x='540' y='"
+                             (* 0.5 (+ (actx-y (:actx delta)) (ch-y (:ch delta))))
+                             "'>" (:ch-name delta) "</text>"])])
                  :actx-start (when (> (actx-y (:child-actx delta)) line-height)
                                ["<g transform='translate(30," (actx-y (:actx delta)) ")'>"
                                 "<line class='delta' x1='0' y1='0' x2='30' y2='"


Story ID: RPC-219

Story ID: RPC-219

Summary: Namespaces have a folded indicator (a triangle to their left); can only be toggled by clicking on their title (was entire body before); and are wrapped in an anchor tag so as to appear clickable when hovered.

--- src/untangled/test/suite.cljs
+++ src/untangled/test/suite.cljs
@@ -155,9 +155,14 @@
                      ]
                  (dom/li #js {:className "test-item "}
                          (dom/div #js {:className (filter-class test-item-data)}
-                                  (dom/span #js {:className (itemclass (:status test-item-data))} (:name test-item-data))
-                                  (dom/ul #js {:className "test-list"} (mapv test-result (:test-results test-item-data)))
-                                  (dom/ul #js {:className "test-list"} (mapv (comp test-item #(assoc % :report/filter filter)) (:test-items test-item-data)))
+                                  (dom/span #js {:className (itemclass (:status test-item-data))}
+                                            (:name test-item-data))
+                                  (dom/ul #js {:className "test-list"}
+                                          (mapv test-result
+                                                (:test-results test-item-data)))
+                                  (dom/ul #js {:className "test-list"}
+                                          (mapv (comp test-item #(assoc % :report/filter filter))
+                                                (:test-items test-item-data)))
                                   )
                          ))))

@@ -172,12 +177,16 @@
                folded? (:folded? tests-by-namespace)
                toggle-folded! (:toggle-folded! tests-by-namespace)]
            (dom/li #js {:className "test-item"}
-                   (dom/div #js {:className "test-namespace"
-                                 :onClick   toggle-folded!}
-                            (dom/h2 #js {:className (itemclass (:status tests-by-namespace))}
-                                    "Testing " (:name tests-by-namespace))
+                   (dom/div #js {:className "test-namespace"}
+                            (dom/a #js {:href "#"
+                                        :style #js {:text-decoration "none"} ;; TODO: refactor to css
+                                        :onClick   toggle-folded!}
+                                   (dom/h2 #js {:className (itemclass (:status tests-by-namespace))}
+                                           (if folded? \u25BA \u25BC)
+                                           "Testing " (:name tests-by-namespace)))
                             (dom/ul #js {:className (if folded? "hidden" "test-list")}
-                                    (mapv (comp test-item #(assoc % :report/filter filter)) (:test-items tests-by-namespace)))
+                                    (mapv (comp test-item #(assoc % :report/filter filter))
+                                          (:test-items tests-by-namespace)))
                             )
                    ))))

@@ -192,28 +201,32 @@
                      test-report-data (-> props :top)
                      current-filter (-> props :report/filter)
                      folded-namespaces (-> props :folded/namespaces)
-                     toggle-folded! (fn [n] #(om/transact! this `[(~'toggle-folded ~{:name n})]))]
+                     make-toggle-fn (fn [n] #(om/transact! this `[(~'toggle-folded ~{:name n})]))]
                  (dom/section #js {:className "test-report"}
                               (dom/div #js {:name "filters" :className "filter-controls"}
                                        (dom/label #js {:htmlFor "filters"} "Filter: ")
                                        (dom/a #js {:className (if (= current-filter :all) "selected" "")
-                                                   :onClick   #(om/transact! this '[(filter-all)])} "All")
+                                                   :onClick   #(om/transact! this '[(filter-all)])}
+                                              "All")
                                        (dom/a #js {:className (if (= current-filter :manual) "selected" "")
-                                                   :onClick   #(om/transact! this '[(filter-manual)])} "Manual")
+                                                   :onClick   #(om/transact! this '[(filter-manual)])}
+                                              "Manual")
                                        (dom/a #js {:className (if (= current-filter :failed) "selected" "")
-                                                   :onClick   #(om/transact! this '[(filter-failed)])} "Failed"))
+                                                   :onClick   #(om/transact! this '[(filter-failed)])}
+                                              "Failed"))
                               (dom/ul #js {:className "test-list"} (mapv (comp test-namespace
                                                                                #(assoc %
                                                                                :report/filter current-filter
-                                                                                :toggle-folded! (toggle-folded! (:name %))
+                                                                                :toggle-folded! (make-toggle-fn (:name %))
                                                                                :folded? (contains? folded-namespaces (:name %))
                                                                                ))
                                                                          (:namespaces test-report-data)))
                               (let [rollup-stats (reduce (fn [acc item]
                                                            (let [counts [(:passed item) (:failed item) (:error item)
                                                                          (+ (:passed item) (:failed item) (:error item))]]
-                                                             (map + acc counts))
-                                                           ) [0 0 0 0] (:namespaces test-report-data))]
+                                                             (map + acc counts)
+                                                             ))
+                                                         [0 0 0 0] (:namespaces test-report-data))]
                                 (if (< 0 (+ (nth rollup-stats 1) (nth rollup-stats 2)))
                                   (change-favicon-to-color "#d00")
                                   (change-favicon-to-color "#0d0"))


Return to deftypes

Return to deftypes

--- lazytest.clj
+++ lazytest.clj
@@ -1,16 +1,11 @@
-;; I want to use deftype, but literal deftype'd objects cannot be
-;; 9embedded in generated code.
+(deftype Context [before after])

-(defn TestCase [contexts locals children]
-  (with-meta {:contexts contexts
-              :locals locals
-              :children children}
-    {:type ::TestCase}))
+(deftype Assertion [locals form])

-(defn Context [before after]
-  (with-meta {:before before
-              :after after}
-    {:type ::Context}))
+(deftype TestCase [contexts children])
+
+(defprotocol TestCompilable
+  (test-compile [x]))

 (defprotocol TestSuccess
   (success? [r] "Returns true if r is a 100% successful result."))
@@ -28,28 +23,15 @@
   TestSuccess (success? [] false))

 (defn format-assertion [a]
-  `(try (if ~a
-          (AssertionPassed '~a)
-          (AssertionFailed '~a))
-        (catch Throwable t#
-          (AssertionThrown '~a t#))))
-
-(defn format-tests [t]
-  (let [active (gensym "active")]
-    `(fn [~active ~@(:locals t) & states#]
-       (lazy-seq
-        ~(loop [r nil
-                children (reverse (:children t))]
-           (if (seq children)
-             (let [c (first children)]
-               (recur (if (= ::TestCase (type c))
-                        `(cons (run-tests '~c ~active) ~r)
-                        `(cons ~(format-assertion c) ~r))
-                      (next children)))
-             r))))))
-
-(defn compile-tests [t]
-  (eval (format-tests t)))
+  {:pre [(= ::Assertion (type a))
+         (vector? (:locals a))]}
+  (let [form (:form a)]
+    `(fn ~(vec (cons (gensym) (:locals a)))
+       (try (if ~form
+              (AssertionPassed '~form)
+              (AssertionFailed '~form))
+            (catch Throwable t#
+              (AssertionThrown '~form t#))))))

 (defn unchunked-map [f coll]
   (lazy-seq
@@ -57,35 +39,44 @@
      (cons (f (first coll))
            (unchunked-map f (next coll))))))

-(defn run-tests [t active]
-  (let [contexts (:contexts t)
-        states (map (fn [c] (or (active c) ((:before c)))) contexts)
-        ;;_ (prn "States are " states)
-        merged (merge active (zipmap contexts states))
-        ;;_ (prn "Merged is " merged)
-        results (apply (compile-tests t) merged states)
-        closed (map (fn [c state]
-                      (when-not (contains? active c) ((:after c))))
-                    (reverse contexts) (reverse states))]
-    (TestResult t results)))
+(def mtest-compile (memoize test-compile))

-(defn doall-results [tr]
-  (doall (tree-seq :children :children tr)))
+(extend-protocol TestCompilable
+ ::Assertion
+ (test-compile [a] (eval (format-assertion a)))
+ ::Context
+ (test-compile [c] (fn ([] (when-let [f (:before c)] (f)))
+                     ([state] (when-let [f (:after c)] (f state)))))
+ ::TestCase
+ (test-compile [t]
+  (let [cfns (map mtest-compile (:contexts t))
+        tfns (map mtest-compile (:children t))
+        open (fn [active] (map (fn [f]
+                                 (prn "Trying to open cfn" f)
+                                 (or (active f) (f))) cfns))
+        close (fn [active states]
+                  (map (fn [c state]
+                         (when-not (contains? active c) (c state)))
+                       (reverse cfns) (reverse states)))]
+    (fn [active & states]
+      (prn "Active is" active)
+       (let [states (open active)
+             merged (merge active (zipmap cfns states))
+             _ (prn "Merged is" merged)
+             results (unchunked-map #(apply % merged states) tfns)]
+         (close active states)
+         (TestResult (str t) results))))))
+
+(defn results-seq [r]
+  (tree-seq :children :children r))

 (def c1 (Context (fn [] (prn "Opening lazy context c1.") 1) nil))

-(def c2 (Context (fn [] (prn "Opening lazy context c2.") 2.5) nil))
+(def a1 (Assertion '[a] '(do (prn "Executing assertion a1.")
+                             (pos? a))))

-(def t1 (TestCase [c1 c2] '[a b]
-                  '[(do (prn "Evaluating test t1-a") (integer? a))
-                    (do (prn "Evaluating test t1-b") (integer? b))]))
+(def t1 (TestCase [c1] [a1]))

-(def t2 (TestCase [c1 c2] '[a b]
-                  '[(do (prn "Evaluating test t2-a") (integer? a))
-                    (do (prn "Evaluating test t2-b") (integer? b))]))
+(def t2 (TestCase [c1] [a1 a1 a1]))

-(def s1 (TestCase [] [] [t1 t2]))
-
-(def s2 (TestCase [c1 c2] [] [t1 t2]))
-
-(def s3 (TestCase [] [] [t1 t2 t1 t2 t1 t2]))
+(def t3 (TestCase [c1] [t1 t1 t1]))


Print doc for failed test in simple-report.

--- lazytest.clj
+++ lazytest.clj
@@ -247,6 +247,7 @@
                  (doseq [c (:children r)]
                    (simple-report c (str indent "   "))))
              (do (println indent "FAIL" (result-identifier r))
+                 (when-let [d (:doc (meta (:source r)))] (prn d))
                  (doseq [c (:children r)]
                    (simple-report c (str indent "     ")))))


update ab.clj

update ab.clj

--- ann/src/ann/ab.clj
+++ ann/src/ann/ab.clj
@@ -26,7 +26,8 @@
    (rand-weight)
    (rand-weight)])

-(def perceptron (create-perceptron))
+;; (def perceptron (create-perceptron))
+(def perceptron (list 0 0 0))

 ;; (def a [1 2 3])
 ;; (def b [4 5 6])
@@ -50,37 +51,22 @@
 (defn train-perceptron
   "训练感知器，返回新的 weights"
   [{inputs :input, target :output, weights :weights}]
-  (def delta 1)
-  (def old-weights nil)
-  (def i 0)
-  (while (and (not (good-enough? delta))
-              (not (could-not-do-better? old-weights weights)))
-    (def i (inc i))
-    (if (= (mod i 100) 0)
-      (println delta weights))
-    (def output (calc inputs weights))
-    (def delta (* (- target output)))
-    (def old-weights weights)
-    (def weights (map (fn [input weight]
-           (+ weight
-              (* delta (sgn input) study-rate)))
-         (concat '(1) inputs)
-         weights)))
-  weights)
-
-
+  (def delta (- target (calc inputs weights)))
+  (map (fn [input weight]
+         (+ weight
+            (* delta (sgn input) study-rate)))
+       (concat '(1) inputs)
+       weights))

 ;;; 对外接口

 (defn train
   "Train NeuralNetwork"
   [{input :input, output :output}]
-  (dotimes [i 1000]
-    ;; (println (str "Train | Input: " input))
-    ;; (println (str "Train | Output: " output))
-    (def perceptron (train-perceptron {:input input, :output output, :weights perceptron}))
-    ;; (println perceptron)
-    ))
+  (println (str "Train | Input: " input))
+  (println (str "Train | Output: " output))
+  (dotimes [i 10000]
+    (def perceptron (train-perceptron {:input input, :output output, :weights perceptron}))))

 (defn run
   ""


super fucking hacky code, but now projectiles move

--- src/voke/system/movement.cljs
+++ src/voke/system/movement.cljs
@@ -38,64 +38,83 @@
   [entity :- Entity]
   (remove-conflicting-directions (safe-get-in entity [:brain :intended-move-direction])))

+; XXXX TODOOOO
+(defn should-update-velocity? [entity]
+  (and
+    (get-in entity [:brain :intended-move-direction])
+    (not-empty (human-controlled-entity-movement-directions entity)))
+  )
+
 (sm/defn update-orientation :- Entity
   [entity :- Entity]
   ; TODO - currently only implemented for player-controlled entities, doesn't handle monsters/projectiles
-  (assoc-in entity
-            [:shape :orientation]
-            (let [directions (human-controlled-entity-movement-directions entity)
-                  intended-direction-values (map direction-value-mappings directions)]
-              (Math/atan2 (apply + (map Math/sin intended-direction-values))
-                          (apply + (map Math/cos intended-direction-values))))))
+  ; TODO don't do any of this for projectiles
+  (if (should-update-velocity? entity)
+    (assoc-in entity
+              [:shape :orientation]
+              (let [directions (human-controlled-entity-movement-directions entity)
+                    intended-direction-values (map direction-value-mappings directions)]
+                (Math/atan2 (apply + (map Math/sin intended-direction-values))
+                            (apply + (map Math/cos intended-direction-values)))))
+    entity))

 (sm/defn update-velocity :- Entity
   [entity :- Entity]
   ; TODO - acceleration will be computed differently for AI-controlled monsters
-  (let [acceleration (if (not-empty (human-controlled-entity-movement-directions entity))
-                       (safe-get-in entity [:motion :max-acceleration])
-                       0)]
-    (if (or (> acceleration 0)
-            (> (or (safe-get-in entity [:motion :velocity :x] 0)
-                   (safe-get-in entity [:motion :velocity :y] 0))))
-      (let [orientation (safe-get-in entity [:shape :orientation])
-            update-axis-velocity (fn [trig-fn axis-velocity]
-                                   (let [new-velocity (min (safe-get-in entity [:motion :max-speed])
-                                                           (+ axis-velocity
-                                                              (* acceleration
-                                                                 (trig-fn orientation))))]
-                                     (if (> (Math/abs new-velocity) min-velocity)
-                                       new-velocity
-                                       0)))]
-        (-> entity
-            (update-in [:motion :velocity :x]
-                       (partial update-axis-velocity Math/cos))
-            (update-in [:motion :velocity :y]
-                       (partial update-axis-velocity Math/sin))))
-      entity)))
+  ; TODO don't do any of this for projectiles
+  (if-let [acceleration (when (should-update-velocity? entity)
+                          (safe-get-in entity [:motion :max-acceleration]))]
+    (let [orientation (safe-get-in entity [:shape :orientation])
+          update-axis-velocity (fn [trig-fn axis-velocity]
+                                 (let [new-velocity (min (safe-get-in entity [:motion :max-speed])
+                                                         (+ axis-velocity
+                                                            (* acceleration
+                                                               (trig-fn orientation))))]
+                                   (if (> (Math/abs new-velocity) min-velocity)
+                                     new-velocity
+                                     0)))]
+      (-> entity
+          (update-in [:motion :velocity :x]
+                     (partial update-axis-velocity Math/cos))
+          (update-in [:motion :velocity :y]
+                     (partial update-axis-velocity Math/sin))))
+    entity))

 (sm/defn apply-friction :- Entity
   [entity :- Entity]
+  (if (= (get-in entity [:collision :type])
+         :projectile)
+    entity
+    (reduce
+      (fn [entity axis]
+        (update-in entity [:motion :velocity axis] #(* % friction-value)))
+      entity
+      [:x :y])))
+
+(sm/defn update-position :- Entity
+  [entity :- Entity]
   (reduce
     (fn [entity axis]
-      (update-in entity [:motion :velocity axis] #(* % friction-value)))
+      (update-in entity
+                 [:shape axis]
+                 #(+ % (safe-get-in entity [:motion :velocity axis]))))
     entity
     [:x :y]))

-(sm/defn update-position :- Entity
-  [entity :- Entity]
-  (-> entity
-      (update-in [:shape :x]
-                 (fn [x]
-                   (+ x (safe-get-in entity [:motion :velocity :x]))))
-      (update-in [:shape :y]
-                 (fn [y]
-                   (+ y (safe-get-in entity [:motion :velocity :y]))))))
+; XXXX TODO
+(defn relevant?
+  [entity]
+  (js/console.log (clj->js entity))
+  (or
+    (seq (get-in entity [:brain :intended-move-direction] nil))
+    (not= (get-in entity [:motion :velocity :x] 0) 0)
+    (not= (get-in entity [:motion :velocity :y] 0) 0)))

 ;; System definition

 (sm/def move-system :- System
   {:every-tick {:fn (fn move-system-tick [entities publish-chan]
-                      (doseq [entity (filter #(get-in % [:brain :intended-move-direction]) entities)]
+                      (doseq [entity (filter relevant? entities)]
                         (let [moved-entity (-> entity
                                                update-orientation
                                                update-velocity


Update Jetty to 9.4.42

Update Jetty to 9.4.42

Fixes two known vulnerabilities in Jetty:
- https://nvd.nist.gov/vuln/detail/CVE-2021-28169
- https://nvd.nist.gov/vuln/detail/CVE-2021-34428

--- ring-jetty-adapter/project.clj
+++ ring-jetty-adapter/project.clj
@@ -7,7 +7,7 @@
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [ring/ring-core "1.9.3"]
                  [ring/ring-servlet "1.9.3"]
-                 [org.eclipse.jetty/jetty-server "9.4.40.v20210413"]]
+                 [org.eclipse.jetty/jetty-server "9.4.42.v20210604"]]
   :aliases {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10" "test"]}
   :profiles
   {:dev  {:dependencies [[clj-http "3.10.0"]


ui cleanup

ui cleanup

--- src/cljs/core.cljs
+++ src/cljs/core.cljs
@@ -56,6 +56,8 @@
 (defn inspect-view []
   [:div
    [known-types @appstate/known-event-types appstate/selected-event-types]
+   [:br]
+   [:br]
    [:button#get-next {:on-click get-next} "Next"]
    [:input {:type "number"
             :value (:next-n @appstate/app)


Update *loaded-libs* in the Boxure thread. Required since Boxure defrecord was changed.

--- src/containium/modules/boxes.clj
+++ src/containium/modules/boxes.clj
@@ -49,8 +49,11 @@
                               #_else boxure-config)
               box-debug (System/getenv "BOXDEBUG")
               box (boxure (assoc boxure-config :debug? box-debug) (.getClassLoader clojure.lang.RT) file)
-              injected @(boxure/eval box '(clojure.lang.Namespace/injectFromRoot "containium\\.(?!core).*|ring\\.middleware.*"))
-              _ (dosync (commute (:loaded box) #(apply conj % (keys injected))))
+              injected @(boxure/eval box '(let [injected (clojure.lang.Namespace/injectFromRoot
+                                                          "containium\\.(?!core).*|ring\\.middleware.*")]
+                                            (dosync (commute @#'clojure.core/*loaded-libs*
+                                                             #(apply conj % (keys injected))))
+                                            injected))
               _ (when box-debug (prn "Loaded after namespace injection: " @(:loaded box)))
               active-profiles (-> (meta project) :active-profiles set)
               descriptor (merge {:dev? (not (nil? (active-profiles :dev)))} ; implicit defaults


fix bug: use default io error handler, not auth handler

--- src/yeller_clojure_client.clj
+++ src/yeller_clojure_client.clj
@@ -43,7 +43,7 @@
             ((:auth-error-handler options default-auth-error-handler)
                backend e))
           (reportIOError [this backend e]
-            ((:auth-io-handler options default-auth-error-handler)
+            ((:auth-io-handler options default-io-error-handler)
                backend e)))))
     client))


Clean up dead code, make execute-steps more readable

--- src/clj/lambdacd/execution/internal/execute_steps.clj
+++ src/clj/lambdacd/execution/internal/execute_steps.clj
@@ -65,21 +65,15 @@
       (event-bus/unsubscribe ctx :step-result-updated subscription)
       result)))

-
-(defn- wrap-filter-nil-steps [handler]
-  (fn [step-contexts-and-steps args ctx]
-    (handler (filter (fn [[_ step]] (not-nil? step)) step-contexts-and-steps)
-             args
-             ctx)))
-
 ; TODO: this should be in a namespace like lambdacd.execution.core?
 (defn execute-steps [steps args ctx & {:keys [step-result-producer is-killed unify-results-fn retrigger-predicate]
                                        :or   {step-result-producer (serial-step-result-producer)
                                               is-killed            (atom false)
                                               unify-results-fn     (unify/unify-only-status unify/successful-when-all-successful)
                                               retrigger-predicate  retrigger/sequential-retrigger-predicate}}]
-  (let [handler-chain (-> (call-step-result-producer step-result-producer)
-                          (wrap-inheritance unify-results-fn)
-                          (kill/wrap-execute-steps-with-kill-handling is-killed)
-                          (retrigger/wrap-retrigger-handling retrigger-predicate))]
-    (handler-chain (contexts-for-steps (filter not-nil? steps) ctx) args ctx)))
+  (let [handler-chain      (-> (call-step-result-producer step-result-producer)
+                               (wrap-inheritance unify-results-fn)
+                               (kill/wrap-execute-steps-with-kill-handling is-killed)
+                               (retrigger/wrap-retrigger-handling retrigger-predicate))
+        contexts-and-steps (contexts-for-steps (filter not-nil? steps) ctx)]
+    (handler-chain contexts-and-steps args ctx)))


added a comment so others dont have to go through what i did

--- src-cljs/frontend/models/user.cljs
+++ src-cljs/frontend/models/user.cljs
@@ -52,5 +52,8 @@
       (assoc :bitbucket_authorized nil)))

 (defn primary-email [user]
-  ;; We shove the primary email into :selected_email in the api layer.
+  ;; We shove the primary email into :selected_email in the api layer, even
+  ;; though we have a :selected-email key in the collection which is different.
+  ;; Encapsulating this logic in case we ever want to make the :selected_email on
+  ;; the FE == the :selected-email on the BE.
   (:selected_email user))


add traveler to system-applications

add traveler to system-applications

--- src/galleon/applications.clj
+++ src/galleon/applications.clj
@@ -6,7 +6,9 @@
             [gangway.web]
             [navigator.schema :as n-schema]
             [navigator]
-            [timber.core :as timber]))
+            [timber.core :as timber]
+            [traveler.core :as tr-core]
+            [traveler.schema :as tr-schema]))

 (def system-applications
   [#_
@@ -18,6 +20,11 @@
     :helmsman-definition nil}
    {:app-name "Timber"
     :helmsman-definition timber/helmsman-assets}
+   {:app-name "Traveler"
+    :schema tr-schema/traveler-schema
+    :helmsman-context "traveler"
+    :helmsman-definition-db-conn true
+    :helmsman-definition tr-core/helmsman-definition}
    {:app-name "Navigator"
     :schema n-schema/schema
     :helmsman-context "navigator"


working on leaf-neighbours handling

working on leaf-neighbours handling

--- sample/src/sample/btree.clj
+++ sample/src/sample/btree.clj
@@ -6,6 +6,11 @@
             [sample.memoryfactstore :as mfs]
             [clojure.tools.logging :as log]))

+
+(defn assoc-if-not-nil [m k v]
+  (if-not (nil? k)
+    (assoc m k v)
+    m))

 #_(defrecord BinaryTreeNode [k* v* l r]
@@ -172,7 +177,7 @@

 (defprotocol B+TreeModifyable
-  (insert [this k v]))
+  (insert [this k v leaf-neighbours]))

 (defprotocol B+TreeLookupable
   (lookup [this k])
@@ -200,7 +205,7 @@

   B+TreeModifyable

-  (insert [this k v]
+  (insert [this k v leaf-neighbours]
     (letfn [(split [{:keys [b ks vs size] :as n}]
               (let [partition-size  (-> size (/ 2) Math/ceil int)
                     [ks1 ks2]       (partition-all partition-size ks)
@@ -209,7 +214,8 @@
                     vs2             (concat vs2a vs2b)]
                 [(->B+TreeInternalNode b (dec partition-size) ks1 vs1)
                  nk
-                 (->B+TreeInternalNode b (- partition-size (rem size 2)) ks2 vs2)]))
+                 (->B+TreeInternalNode b (- partition-size (rem size 2)) ks2 vs2)
+                 leaf-neighbours]))

             (ins [{:keys [b ks vs size] :as n} k v]
               (if-not (= k ::inf)
@@ -225,15 +231,15 @@
                 (let [nvs (-> vs butlast (concat [v]))]
                   (->B+TreeInternalNode b size ks nvs))))]

-      (let [[childk childv] (lookup this k)
-            [n1 nk n2]      (insert childv k v)
-            nn              (if (nil? n2)
-                              (ins this childk n1)
-                              (-> (ins this nk n1)
-                                  (ins childk n2)))]
+      (let [[childk childv]  (lookup this k)
+            [n1 nk n2 nlnbs] (insert childv k v leaf-neighbours)
+            nn               (if (nil? n2)
+                               (ins this childk n1)
+                               (-> (ins this nk n1)
+                                   (ins childk n2)))]
         (if (>= (-> nn :size) b)
           (split nn)
-          [nn]))))
+          [nn nil nil nlnbs]))))

   B+TreeLookupable

@@ -258,8 +264,31 @@

   B+TreeModifyable

-  (insert [this k v]
-    (letfn [(split [{:keys [b m size] :as n}]
+  (insert [this k v leaf-neighbours]
+    (letfn [(insert-leaf-neighbours [n n1]
+              (let [{pleaf :prev nleaf :next} (get leaf-neighbours n)
+                    {ppleaf :prev}            (when-not (nil? pleaf)
+                                                (get leaf-neighbours pleaf))
+                    {nnleaf :next}            (when-not (nil? nleaf)
+                                                (get leaf-neighbours nleaf))]
+                (-> leaf-neighbours
+                    (assoc-if-not-nil pleaf {:prev ppleaf :next n1})
+                    (assoc-if-not-nil n1    {:prev pleaf  :next nleaf})
+                    (assoc-if-not-nil nleaf {:prev n1     :next nnleaf}))))
+
+            (update-leaf-neighbours [n n1 n2]
+              (let [{pleaf :prev nleaf :next} (get leaf-neighbours n)
+                    {ppleaf :prev}            (when-not (nil? pleaf)
+                                                (get leaf-neighbours pleaf))
+                    {nnleaf :next}            (when-not (nil? nleaf)
+                                                (get leaf-neighbours nleaf))]
+                (-> leaf-neighbours
+                    (assoc-if-not-nil pleaf {:prev ppleaf :next n1})
+                    (assoc-if-not-nil n1    {:prev pleaf  :next n2})
+                    (assoc-if-not-nil n2    {:prev n1     :next nleaf})
+                    (assoc-if-not-nil nleaf {:prev n2     :next nnleaf}))))
+
+            (split [{:keys [b m size] :as n}]
               (let [partition-size (-> size (/ 2) Math/ceil int)
                     [ks1 ks2] (partition-all partition-size (keys m))
                     m1 (apply dissoc m ks2)
@@ -267,8 +296,10 @@
                     n1size partition-size
                     n2size (- partition-size (rem size 2))
                     n2 (->B+TreeLeafNode b n2size m2)
-                    n1 (->B+TreeLeafNode b n1size m1)]
-                [n1 (last ks1) n2]))
+                    n1 (->B+TreeLeafNode b n1size m1)
+                    nleafnbs (update-leaf-neighbours n n1 n2)]
+                (println "NLEAFNBS" nleafnbs)
+                [n1 (last ks1) n2 nleafnbs]))

             (ins [{:keys [b m size] :as n} k v]
               (let [nsize (if (contains? m k) size (inc size))
@@ -278,7 +309,7 @@
       (let [nn (ins this k v)]
         (if (>= (-> nn :size) b)
           (split nn)
-          [nn]))))
+          [nn nil nil (insert-leaf-neighbours this nn)]))))

   B+TreeLookupable

@@ -326,11 +357,11 @@
                                                 :next next}))
                                {}))))]

-      (let [[n1 k n2] (insert root k v)
+      (let [[n1 k n2 nlnbs] (insert root k v leaf-neighbours)
             nroot (if (nil? n2)
                     n1
                     (->B+TreeInternalNode b 1 [k] [n1 n2]))]
-        (->B+Tree b nroot {} #_(neighbour-map nroot)))))
+        (->B+Tree b nroot nlnbs))))

   t/TreeLookupable


fix operation-name for executor

fix operation-name for executor

--- src/graphql_clj/executor.clj
+++ src/graphql_clj/executor.clj
@@ -255,7 +255,8 @@
   ;; statements.
   ;; (println "document:" document)
   (let [operations (if operation-name
-                     (filter #(= (:operation-name %) operation-name) document)
+                     (filter (fn [op]
+                               (= (str (:name op)) operation-name)) document)
                      document)
         operation (first operations)
         operation-count (count operations)]
@@ -278,12 +279,12 @@
                         :resolver (resolver/create-resolver-fn schema resolver-fn)}
                        operation-name)))
   ([context validated-schema resolver-fn validated-document]
-   (execute-validated-document context validated-schema resolver-fn validated-document nil))
+   (execute-validated-document context validated-schema resolver-fn validated-document nil nil))
   ([context validated-schema resolver-fn validated-document variables]
    (execute-validated-document context validated-schema resolver-fn validated-document variables nil)))

 (defn execute
-  ([context string-or-validated-schema resolver-fn string-or-validated-document variables]
+  ([context string-or-validated-schema resolver-fn string-or-validated-document variables operation-name]
    (let [validated-schema (if (string? string-or-validated-schema)
                             (sv/validate-schema string-or-validated-schema)
                             string-or-validated-schema)
@@ -293,8 +294,10 @@
                                 (catch Exception e
                                   [(:errors (ex-data e)) nil]))
                               string-or-validated-document)]
-     (execute-validated-document context validated-schema resolver-fn validated-document variables)))
-  ([context valid-schema resolver-fn string-or-validated-document]
-   (execute context valid-schema resolver-fn string-or-validated-document nil)))
-
-
+     (execute-validated-document context validated-schema resolver-fn validated-document variables operation-name)))
+  ([context string-or-validated-schema resolver-fn string-or-validated-document variables]
+   (execute context string-or-validated-schema resolver-fn string-or-validated-document variables nil))
+  ([context string-or-validated-schema resolver-fn string-or-validated-document]
+   (execute context string-or-validated-schema resolver-fn string-or-validated-document nil nil)))
+
+


add commodity api update test

add commodity api update test

--- test/clj_money/api/commodities_test.clj
+++ test/clj_money/api/commodities_test.clj
@@ -78,3 +78,27 @@
         (is (= 201 (:status response)) "The response is a successful creation")
         (is (-> response :body :id)
             "The response contains the new commodity id.")))))
+
+(deftest update-a-commodity
+  (let [context (serialization/realize storage-spec commodities-context)
+        commodity (find-commodity context "USD")]
+    (testing "A user cannot update a commodity for another user's entity"
+      (is (thrown? ExceptionInfo
+                   (with-authentication (find-user context "jane@doe.com")
+                     (api/update {:params {:id (:id commodity)
+                                           :name "US Doll Hairs"
+                                           :symbol "USD"
+                                           :type "currency"}})))))
+    (testing "A user can update a commodity in their entity"
+      (let [response (with-authentication (find-user context "john@doe.com")
+                     (api/update {:params {:id (:id commodity)
+                                           :name "US Doll Hairs"
+                                           :symbol "USD"
+                                           :type "currency"}}))
+            entity (find-entity context "Personal")
+            commodities (commodities/search storage-spec {:entity-id (:id entity)})]
+        (is (= 200 (:status response)) "The response is successful")
+        (is (= #{"US Doll Hairs"} (->> commodities
+                                       (map :name)
+                                       (into #{})))
+            "The commodity is updated in the data store.")))))


More sandbox code

More sandbox code

--- src/core/core.cljs
+++ src/core/core.cljs
@@ -46,10 +46,15 @@
 ;; (import-db/import-meta-projects)

 (import-db/import-all-projects!)
+
 (let [projects (state/list-of-projects)]
   (js/console.log (count projects))
   (doseq [project projects]
     (js/console.log (:name project))))
+
+(let [tasks (:tasks (state/inbox))]
+  (doseq [t tasks]
+    (js/console.log (:name t))))

 ;; (state/register-project "first-project"
 ;;                       :tasks [{:id 1 :name "foo"}


Fix schema

Fix schema

--- src/icecap/handlers/core.clj
+++ src/icecap/handlers/core.clj
@@ -1,4 +1,6 @@
-(ns icecap.handlers.core)
+(ns icecap.handlers.core
+  "The core handler API."
+  (:require [schema.core :as s]))

 (defmulti get-schema :type)
 (defmulti execute :type)
@@ -10,7 +12,7 @@
   implicitly added.
   "
   [type schema & forms]
-  (let [full-schema (assoc schema :type type)]
+  (let [full-schema (assoc schema :type (s/eq type))]
     `(do
        (defmethod get-schema ~type
          [~'step]


Newlines are your friends

Newlines are your friends

--- test/desdemona/jobs/sample_job_test.clj
+++ test/desdemona/jobs/sample_job_test.clj
@@ -9,7 +9,12 @@

 (deftest build-job-test
   (let [{:keys [catalog workflow lifecycles]} (build-job)
-        expected-catalog-names [:original-wrapper :determine-origin :build-row :prepare-rows :read-lines :write-lines]
+        expected-catalog-names [:original-wrapper
+                                :determine-origin
+                                :build-row
+                                :prepare-rows
+                                :read-lines
+                                :write-lines]
         expected-workflow [[:read-lines :original-wrapper]
                            [:original-wrapper :determine-origin]
                            [:determine-origin :build-row]


accept keyword as selector and return seq instead of array for queries matching >1 nodes


Set the state to new when creating

Set the state to new when creating


[#3414]

[#3414]

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/wallet/choose_recipient/views.cljs
+++ src/status_im/ui/screens/wallet/choose_recipient/views.cljs
@@ -44,9 +44,9 @@
   (int (* 2 (/ (min height width) 3))))

 (defview choose-recipient []
-  (letsubs [dimensions        (react/get-dimensions "window")
-            camera-flashlight [:wallet.send/camera-flashlight]
-            view              [:get :view-id]]
+  (letsubs [read-once?        (atom false)
+            dimensions        (react/get-dimensions "window")
+            camera-flashlight [:wallet.send/camera-flashlight]]
     [react/view {:style styles/qr-code}
      [status-bar/status-bar {:type :transparent}]
      [toolbar-view camera-flashlight]
@@ -61,7 +61,9 @@
                        :aspect        :fill
                        :captureAudio  false
                        :torchMode     (camera/set-torch camera-flashlight)
-                       :onBarCodeRead #(re-frame/dispatch [:wallet/fill-request-from-url (camera/get-qr-code-data %) nil])}]]
+                       :onBarCodeRead #(when-not @read-once?
+                                         (reset! read-once? true)
+                                         (re-frame/dispatch [:wallet/fill-request-from-url (camera/get-qr-code-data %) nil]))}]]
       [viewfinder dimensions (size dimensions)]]
      [bottom-buttons/bottom-button
       [button/button {:disabled?           false


Makes bytes static

Makes bytes static


script path finder

script path finder

--- worker/src/worker/worker.cljs
+++ worker/src/worker/worker.cljs
@@ -1,7 +1,25 @@
+(ns worker.worker (:require [goog.dom :as dom]))
+
+(declare cljs-output-file)
+
+(def *closure-base-path* goog/basePath)
+(def *closure-base-file* (str *closure-base-path* "base.js"))
 (def *document* {
   :getElementsByTagName "function() {return [];}"
 })

+(defn scripts-src []
+  (let [scripts (.getElementsByTagName (dom/getDocument) "SCRIPT")]
+    (->> (for [i (range (.-length scripts))] (aget scripts i))
+         (remove #(empty? (.-src %)))
+         (map #(.-src %)))))
+
+(defn cljs-output-file []
+  (if-not (empty? *closure-base-path*)
+    (str *closure-base-path* "../cljs_deps.js")
+    (first (scripts-src))))
+
+(def *cljs-output-file* (cljs-output-file))
 (defn worker-body [[ns* fn*]]
   (let [
     multi-loader (str


Use DB connection configuration from config.edn

--- src/formlogic/db.clj
+++ src/formlogic/db.clj
@@ -1,10 +1,14 @@
 (ns formlogic.db
-  (:require [yesql.core :refer [defqueries]]))
+  (:require [yesql.core :refer [defqueries]]
+            [formlogic.config :refer [cget]]))

 (def db-spec {:classname "org.postgresql.Driver"
               :subprotocol "postgresql"
-              :subname "//localhost:5432/formlogic"
-              :user "formlogic"})
+              :subname (format "//%s:%d/%s"
+                               (cget :db :host)
+                               (cget :db :port)
+                               (cget :db :database))
+              :user (cget :db :user)})

 (defqueries "sql/get.sql" {:connection db-spec})
 (defqueries "sql/insert.sql" {:connection db-spec})


Implemented 8/8 cases. One needs correction.

--- src/forumdb/core.clj
+++ src/forumdb/core.clj
@@ -1,5 +1,5 @@
 (ns forumdb.core
-  (:import [org.hypergraphdb HGEnvironment HGHandle HGPlainLink HGQuery$hg HGQuery]
+  (:import [org.hypergraphdb HGEnvironment HGHandle HGPlainLink HGQuery$hg HGQuery HGValueLink]
            (java.util Locale TimeZone)
            (java.text SimpleDateFormat)
            (java.io File)
@@ -145,7 +145,8 @@
               ;(. @database add (HGPlainLink. (into-array HGHandle [threadHandle userHandle postHandle])))
               (HGQuery$hg/addUnique @database (HGRel. (into-array HGHandle [userHandle threadHandle])) userThreadRelType (HGQuery$hg/link (into-array HGHandle [userHandle threadHandle])))
               (. @database add (HGRel. (into-array HGHandle [userHandle postHandle])) userPostRelType)
-              (. @database add (HGRel. (into-array HGHandle [threadHandle postHandle])) threadPostRelType)
+              ;(. @database add (HGRel. (into-array HGHandle [threadHandle postHandle])) threadPostRelType)
+              (. @database add (HGValueLink. (. (. post getCreateTime) getMillis) (into-array HGHandle [threadHandle postHandle])))

               (def saveTime (+ saveTime (- (System/currentTimeMillis) saveStart)))
               )
@@ -157,31 +158,31 @@
             )
           )

-        (println "Preprocessing...")
-        (let [saveStart (System/currentTimeMillis)]
-          (do
-            (def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
-            (println 1)
-            (def threadsPostsLinks (doall (map (fn [threadHandle] (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident threadHandle) (HGQuery$hg/type threadPostRelType)])))) threadHandles)))
-            (println 2)
-            (def threadsPosts (doall (map (fn [threadPostsLinks] (map (fn [threadPostLink] (HGQuery$hg/findOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/target threadPostLink) (HGQuery$hg/type Post)])))) threadPostsLinks)) threadsPostsLinks)))
-            (println 3)
-            (def threadsFirstPost (doall (map (fn [threadPosts] (reduce (fn [currentFirstPost threadPost] (if (t/before? (. (. @database get currentFirstPost) getCreateTime) (. (. @database get threadPost) getCreateTime)) currentFirstPost threadPost)) threadPosts)) threadsPosts)))
-            (println 4)
-            ;(map (fn [threadHandle threadFirstPost] (. @database add (HGRel. (into-array HGHandle [threadHandle threadFirstPost])) threadFirstPostRelType)) threadHandles threadsFirstPost)
-            (doseq [threadPostPair (map vector threadHandles threadsFirstPost)]
-              (. @database add (HGRel. (into-array HGHandle [(first threadPostPair) (last threadPostPair)])) threadFirstPostRelType)
-              )
-
-            (def saveTime (+ saveTime (- (System/currentTimeMillis) saveStart)))
-            (def preprocessTime (- (System/currentTimeMillis) saveStart))
-            )
-          )
+        ;(println "Preprocessing...")
+        ;(let [saveStart (System/currentTimeMillis)]
+        ;  (do
+        ;    (def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
+        ;    (println 1)
+        ;    (def threadsPostsLinks (doall (map (fn [threadHandle] (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident threadHandle) (HGQuery$hg/type threadPostRelType)])))) threadHandles)))
+        ;    (println 2)
+        ;    (def threadsPosts (doall (map (fn [threadPostsLinks] (map (fn [threadPostLink] (HGQuery$hg/findOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/target threadPostLink) (HGQuery$hg/type Post)])))) threadPostsLinks)) threadsPostsLinks)))
+        ;    (println 3)
+        ;    (def threadsFirstPost (doall (map (fn [threadPosts] (reduce (fn [currentFirstPost threadPost] (if (t/before? (. (. @database get currentFirstPost) getCreateTime) (. (. @database get threadPost) getCreateTime)) currentFirstPost threadPost)) threadPosts)) threadsPosts)))
+        ;    (println 4)
+        ;    ;(map (fn [threadHandle threadFirstPost] (. @database add (HGRel. (into-array HGHandle [threadHandle threadFirstPost])) threadFirstPostRelType)) threadHandles threadsFirstPost)
+        ;    (doseq [threadPostPair (map vector threadHandles threadsFirstPost)]
+        ;      (. @database add (HGRel. (into-array HGHandle [(first threadPostPair) (last threadPostPair)])) threadFirstPostRelType)
+        ;      )
+        ;
+        ;    (def saveTime (+ saveTime (- (System/currentTimeMillis) saveStart)))
+        ;    (def preprocessTime (- (System/currentTimeMillis) saveStart))
+        ;    )
+        ;  )

         (def stop (System/currentTimeMillis))
         (println (string/join " " ["Data parsed and saved in" (String/valueOf (/ (- stop start) 1000.0)) "seconds"]))
         (println (string/join " " ["Saving took" (String/valueOf (/ saveTime 1000.0)) "seconds"]))
-        (println (string/join " " ["Preprocessing took" (String/valueOf (/ preprocessTime 1000.0)) "seconds"]))
+        ;(println (string/join " " ["Preprocessing took" (String/valueOf (/ preprocessTime 1000.0)) "seconds"]))
         (println)
       )
       (do
@@ -194,11 +195,20 @@
     (let [operationStart (System/currentTimeMillis)]
       (do
         (println "liczba tematów utworzonych w 2013 roku")
-        (def threadFirstPostLinks (HGQuery$hg/findAll @database (HGQuery$hg/type threadFirstPostRelType)))
-        (println (count threadFirstPostLinks))
-        (def threadFirstPosts (map (fn [threadFirstPostLink] (HGQuery$hg/getOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (HGQuery$hg/target threadFirstPostLink)])))) threadFirstPostLinks))
-        (println (count threadFirstPosts))
-        (println (. (filter (fn [threadFirstPost] (t/within? (t/interval (t/date-time 2013) (t/date-time 2014)) (. threadFirstPost getCreateTime))) threadFirstPosts) size))
+        ;(def threadFirstPostLinks (HGQuery$hg/findAll @database (HGQuery$hg/type threadFirstPostRelType)))
+        ;(println (count threadFirstPostLinks))
+        ;(def threadFirstPosts (map (fn [threadFirstPostLink] (HGQuery$hg/getOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (HGQuery$hg/target threadFirstPostLink)])))) threadFirstPostLinks))
+        ;(println (count threadFirstPosts))
+        ;(println (. (filter (fn [threadFirstPost] (t/within? (t/interval (t/date-time 2013) (t/date-time 2014)) (. threadFirstPost getCreateTime))) threadFirstPosts) size))
+        (def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
+        (def threadFirstPosts (map (fn [threadHandle] (reduce (fn [currentFirstThreadPostLink threadPostLink] (if (< (. currentFirstThreadPostLink getValue) (. threadPostLink getValue)) currentFirstThreadPostLink threadPostLink)) (HGQuery$hg/getAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Long) (HGQuery$hg/incident threadHandle)])))) ) threadHandles))
+        (def yearBegin (. (t/date-time 2013) getMillis))
+        (def yearEnd (. (t/date-time 2014) getMillis))
+        (println (count (filter (fn [threadFirstPost] (and (>= (. threadFirstPost getValue) yearBegin) (< (. threadFirstPost getValue) yearEnd))) threadFirstPosts)))
+        ;(def threadFirstPosts (map (fn [threadFirstPostLink] (HGQuery$hg/getOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (HGQuery$hg/target threadFirstPostLink)])))) threadPostLinks))
+        ;(println (count threadFirstPosts))
+        ;(println (. (filter (fn [threadFirstPost] (t/within? (t/interval (t/date-time 2013) (t/date-time 2014)) (. threadFirstPost getCreateTime))) threadFirstPosts) size))
+

         (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
         )
@@ -208,7 +218,12 @@
     (let [operationStart (System/currentTimeMillis)]
       (do
         (println "najbardziej popularny temat w maju 2013")
-
+        (def dateBegin (. (t/date-time 2013 5) getMillis))
+        (def dateEnd (. (t/date-time 2013 6) getMillis))
+        (def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
+        (def threadPostsCounts (map (fn [threadHandle] (count (filter (fn [date] (and (>= date dateBegin) (< date dateEnd))) (map (fn [threadPostLink] (. threadPostLink getValue)) (HGQuery$hg/getAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Long) (HGQuery$hg/incident threadHandle)]))))))) threadHandles))
+        (def mostPopularThread (reduce (fn [x y] (if (> (last x) (last y)) x y)) (map vector threadHandles threadPostsCounts)))
+        (println (. (. @database get (first mostPopularThread)) getTitle) (last mostPopularThread))
         (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
         )
       )
@@ -256,9 +271,9 @@
         ;(def posts (HGQuery$hg/getAll @database (HGQuery$hg/type Post)))
         ;(println (count (filter (fn [post] (if (re-find #"Frodo" (. post getContent)) true false)) posts)))
         (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
-        )
-      )
-    (println)
+        (println)
+        )
+      )

     (let [operationStart (System/currentTimeMillis)]
       (do


#1 Working version with maven retrieved alfresco

--- src/leiningen/amp/deploy.clj
+++ src/leiningen/amp/deploy.clj
@@ -89,13 +89,29 @@
       (main/abort "No target WAR was found. Did you set :amp-target-war in your project.clj?")
       (find-one amp-target-war files))))

-(defn- copy-war
-  "Copies the WAR file where to install the AMP into a working location"
+(defn- reference-war
+  "Creates and validates a path to a target WAR file"
+  [loc]
+  (let [file (io/file loc)]
+    (if (not (.exists ^java.io.File file))
+      (main/abort "The specified WAR file does not exist")
+      file)))
+
+(defn- dependency-war
+  "Creates and validates a target WAR file specified as a project dependency"
   [{:keys [amp-target-war] :as project}]
   (let [dependency (find-dependency project)
         temp-war (io/file (:target-path project) (dep-to-filename amp-target-war))]
     (io/copy dependency temp-war)
     temp-war))
+
+(defn- locate-war
+  "Locates the WAR file to deploy to. The WAR can be specified as the argument,
+   or as a dependency in the project at the entry :amp-target-war"
+  [{:keys [amp-target-war] :as project} args]
+  (if-let [target-war (first args)]
+    (reference-war target-war)
+    (dependency-war project)))

 (defn- install!
   "Uses the Alfresco MMT to install the AMP into the target WAR"
@@ -103,8 +119,10 @@
   (ModuleManagementTool/main (into-array String ["install" (.toString amp) (.toString war)])))

 (defn deploy-amp!
-  "Installs the generated AMP into the specified WAR"
+  "Installs the generated AMP into the specified WAR. If the target WAR is not
+   specified as an argument, it is retrieved from the project at the
+   :amp-target-war"
   [project args]
   (let [amp (locate-amp project)
-        war (copy-war   project)]
+        war (locate-war project) args]
     (install! amp war)))


Add local-repo-path as a top-level def for customization.

--- src/leiningen/util/maven.clj
+++ src/leiningen/util/maven.clj
@@ -29,9 +29,12 @@

 ;; repositories

+(def local-repo-path (.getLocalRepository (make-settings)))
+
 (defn make-local-repo []
-  (let [path (.getLocalRepository (make-settings))
-        url (if (.startsWith path "file:") path (str "file://" path))]
+  (let [url (if (.startsWith local-repo-path "file:")
+              local-repo-path
+              (str "file://" local-repo-path))]
     (-> (.lookup container ArtifactRepositoryFactory/ROLE)
         (.createDeploymentArtifactRepository
          "local" url layout true))))


Fix typo in docstring

Fix typo in docstring

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -1094,7 +1094,7 @@
   browser wraps your code into a function so avoid `function` clause
   at on the top level.

-  Don't forget to add `return <something>` operator if your are
+  Don't forget to add `return <something>` operator if you are
   interested in the result value.

   You may access arguments through the built-in `arguments`
@@ -1102,7 +1102,7 @@
   are JSON-compatible (scalars, maps, vectors).

   The result value is also returned trough JSON encode/decode
-  pipeline (Js objects turn to Clojure maps, arrays into vectors and
+  pipeline (JS objects turn to Clojure maps, arrays into vectors and
   so on).

   Arguments:


report harvest result

report harvest result

--- src/govalert/run.clj
+++ src/govalert/run.clj
@@ -33,7 +33,7 @@
             (log/error "Failed to notify for" index "subscription" subscription))))))

 (defn db-count [index]
-  (with-index index
+  (db/with-index index
     [(search/count-all-agendas)
      (search/count-all-docs)]))

@@ -54,7 +54,8 @@
               (doseq [index (if index [index] (db/indices))]
                  (let [[n-agendas n-docs] (db-count index)]
                    (harvest index)
-                   (log/info "Harvested" (- n-agendas (first (db-count index))) "agendas and" (- n-docs (second (db-count index))) "attachments."))
+                   (let [[na2 nd2] (db-count index)]
+                     (log/info "Harvested" (- n-agendas na2) "of" na2 "agendas and" (- n-docs nd2) "of" nd2 "attachments.")))
                  (notify index :server srv :sender email-admin)))
          ;(catch Exception e
          ;  (feedback (str "Harvest failed" tag) (.getMessage e)))