Little refactoring of normalize

Little refactoring of normalize

It is a monad, but does it save us something?

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

--- src/conexp/contrib/dl/languages/description_graphs.clj
+++ src/conexp/contrib/dl/languages/description_graphs.clj
@@ -60,11 +60,22 @@

 ;;;

+(declare normalize)
+
+(defn- normalize-atomic
+  "Normalizes an atomic expression as needed by normalize-definition."
+  [expr term-names]
+  (if (tbox-target-pair? expr)
+    (let [[tbox target] (uniquify-tbox-target-pair (expression expr)),
+	  tbox (normalize tbox)]
+      [target (into term-names (for [def (tbox-definitions tbox)]
+				 [(definition-expression def) (definition-target def)]))])
+    [expr term-names]))
+
 (defn- normalize-definition
-  "Normalzes given definition with additional defintions, returning
-  the normalized definition and a possibly enhanced structure of
-  definitions. Mixes in tbox-target-pairs."
-  ;; stupid description
+  "Normalizes given definition using term-names (i.e. a map mapping
+  expressions to names), extending term-names if necessary."
+  ;; ugly code, can we do this with monads?
   [definition term-names]
   (let [language (expression-language (definition-expression definition)),
 	target   (definition-target definition),
@@ -82,26 +93,17 @@
 	(let [next-term (first args)]
 	  (if (atomic? next-term)
 	    ;; atomic term, possibly a tbox-target-pair
-	    (if (tbox-target-pair? next-term)
-	      (let [[tbox target] (uniquify-tbox-target-pair (expression next-term))]
-		(recur (rest args) (conj normalized target)
-		       (into names (for [def (tbox-definitions tbox)]
-				     [(definition-expression def) (definition-target def)]))))
-	      (recur (rest args) (conj normalized (expression next-term)) names))
+	    (let [[normal-term new-names] (normalize-atomic next-term names)]
+	      (recur (rest args) (conj normalized normal-term) new-names))

 	    ;; next-term is an existential quantification
 	    (let [[r B] (vec (arguments next-term))]
 	      (if (atomic? B)
 		;; atomic term, possibly a tbox-target-pair
-		(if (tbox-target-pair? B)
-		  (let [[tbox target] (uniquify-tbox-target-pair (expression B))]
-		    (recur (rest args)
-			   (conj normalized (list 'exists (expression r) target))
-			   (into names (for [def (tbox-definitions tbox)]
-					 [(definition-expression def) (definition-target def)]))))
-		  (recur (rest args) (conj normalized (expression next-term)) names))
-
-		;; B is an existential quantification
+		(let [[normal-B new-names] (normalize-atomic B names)]
+		  (recur (rest args) (conj normalized (list 'exists (expression r) normal-B)) new-names))
+
+		;; B is compound
 		(let [name (get names B nil)]
 		  (if-not (nil? name)
 		    (recur (rest args) (conj normalized (list 'exists (expression r) name)) names)


minor

minor

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -2,7 +2,8 @@
   (:require-macros
     [cljs.core.async.macros :refer [go]])
   (:require
-    [cljs.core.async :refer [<! timeout alts! close! chan sliding-buffer filter< put!]]
+    [cljs.core.async :refer [<! timeout alts! close! chan sliding-buffer
+                             filter< put!]]
     [clojure.walk]
     [cljs.reader :refer [read-string]]
     [server.gif :refer [create-html-gif create-canvas-gif]]


use a tx and rx queue

use a tx and rx queue

--- src/tabby/server.clj
+++ src/tabby/server.clj
@@ -30,9 +30,10 @@

 ; yuck
 (defn- append-log [state params]
-  (swap! state assoc :election-timeout (random-election-timeout) )
-  (swap! state check-term params)
-  (swap! state #(update-in % [:log] conj (:entries params)))
+  (swap! state #(-> %1
+                    (assoc :election-timeout (random-election-timeout))
+                    (check-term params)
+                    (update-in [:log] conj (:entries params))))
   (when (> (:leader-commit params) (:commit-index @state))
     (swap! state assoc :commit-index
            (min (:leader-commit params) (count (:log @state))))))
@@ -76,11 +77,12 @@
                           :leader-commit (:commit-index state)})))

 (defn- send-request-vote [state peer]
-  (request-vote peer {:term (:current-term state)
-                      :candidate-id (:id state)
-                      :last-log-index (:commit-index state)
-                      :last-log-term (get-log-term state)}))
-
+  {:dest peer
+   :body {:term (:current-term state)
+          :candidate-id (:id state)
+          :last-log-index (:commit-index state)
+          :last-log-term (get-log-term state)}})
+  ;; (request-vote peer {))

 (defn- broadcast-heartbeat [state]
   (doseq [r (map (partial send-heart-beat state) (:peers state))])
@@ -113,11 +115,12 @@
   state)

 (defn broadcast-request-vote [state]
-  (let [r (map (partial send-request-vote state) (:peers state))]
-    (if (> (->> (map :vote-granted? r) (filter identity) (count))
-           (/ (count (:peers state)) 2))
-      (become-leader state (map :term r))
-      state)))
+  (assoc state :tx-queue (vec (concat (:tx-queue state) (map (partial send-request-vote state) (:peers state))))))
+  ;; (let [r (map (partial send-request-vote state) (:peers state))]
+  ;;   (if (> (->> (map :vote-granted? r) (filter identity) (count))
+  ;;          (/ (count (:peers state)) 2))
+  ;;     (become-leader state (map :term r))
+  ;;     state)))

 (defn check-election-timeout [state]
   (if (election-timeout? state)
@@ -149,6 +152,8 @@
    :voted-for nil  ; persist
    :log [{:term 0 :cmd :init}]         ; persist start at 1
    :id id          ; user assigned
+   :tx-queue []
+   :rx-queue []
    :commit-index 0
    :last-applied 0
    :type :follower


content type "text/html"

content type "text/html"

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -38,7 +38,7 @@

 (defn handler [{{name "name"} :params}]
   (-> (r/response (page name))
-      (r/content-type "application/json")))
+      (r/content-type "text/html")))

 (def app
   (-> handler p/wrap-params))


These two work separately but not together

Probably a stale cookie issue

--- web/test/immutant/web/websocket_test.clj
+++ web/test/immutant/web/websocket_test.clj
@@ -98,30 +98,29 @@
         shared (atom nil)
         handler (fn [{s :session}]
                   (if-let [id (:id s)]
-                    (-> (swap! shared update-in [id] inc)
-                      (get id) str response)
+                    (response (get @shared id))
                     (let [id (rand)]
-                      (-> (reset! shared {id 0})
-                        (get id) str response
+                      (reset! shared {id "identified"})
+                      (-> (response "authorized")
                         (assoc :session {:id id})))))]
     (run (wrap-websocket (wrap-session handler)
            :on-open (fn [ch hs]
                       (let [s (session hs)]
-                        (reset! shared {(:id s) 41})
+                        (reset! shared {(:id s) "hacked"})
                         (deliver result s)))))
-    (is (= "0" (get-body url)))
-    (is (= "1" (get-body url)))
+    (is (= "authorized" (get-body url)))
+    (is (= "identified" (get-body url)))
     (with-open [client (http/create-client)
                 socket (http/websocket client "ws://localhost:8080"
                          :cookies @testing.web/cookies)]
       (let [ring-session (deref result 1000 nil)]
         (is (:id ring-session))))
-    (is (= "42" (get-body url)))
+    (is (= "hacked" (get-body url)))
     (stop)))

 ;; (deftest session-invalidation
 ;;   (let [http (atom {})
-;;         http-session (fn [r] (-> r :server-exchange Sessions/getSession))
+;;         http-session (fn [r] (-> r :server-exchange Sessions/getOrCreateSession))
 ;;         handler (fn [req]
 ;;                   (reset! http (http-session req))
 ;;                   (if-not (-> req :session :foo)


Increase number of clojure threads to 8

Increase number of clojure threads to 8

--- clojure-http-kit/src/sse_server/core.clj
+++ clojure-http-kit/src/sse_server/core.clj
@@ -61,6 +61,6 @@
 (defn -main
   [& args]
   (let [port (parse-port args)]
-    (run-server app {:port port :thread 4 :queue-size 300000})
+    (run-server app {:port port :thread 8 :queue-size 300000})
     (start-timer)
     (print (str "Listening on http://127.0.0.1:" port))))


Scheduler additions for kaleidoscope sketches

--- spectacles/src/spectacles/scheduler.clj
+++ spectacles/src/spectacles/scheduler.clj
@@ -3,6 +3,8 @@
             [spectacles.starfield]
             [spectacles.bet-you-miss]
             [spectacles.cyberspeed]
+            [spectacles.kaleidoscope-logo]
+            [spectacles.kaleidoscope]
             [clojure.core.async :as async]))

 (def sketches {:logo-countdown {:setup  spectacles.present-logo/setup
@@ -39,27 +41,18 @@
                                    :update spectacles.kaleidoscope-logo/update
                                    :draw   spectacles.kaleidoscope-logo/draw
                                    :name   "Kaleidoscope Logo"
-                                   :author "Arthur Hall III"}
-
-               ;; :social-light {:setup  spectacles.social-light/setup
-               ;;                :update spectacles.social-light/update-state
-               ;;                :draw   spectacles.social-light/draw-state
-               ;;                :name   "Socialight"
-               ;;                :author "Aaron Arnett"}
-               })
+                                   :author "Arthur Hall III"}})

 (def installations {:lifeinlights01 :logo-countdown
                     :lifeinlights02 :starfield
                     :lifeinlights03 :bet-you-miss
                     :lifeinlights04 :cyberspeed
                     :lifeinlights05 :kaleidoscope
-                    :lifeinlights06 :kaleidoscope-logo
-                    :lifeinlights07 :social-light
-                    })
+                    :lifeinlights06 :kaleidoscope-logo})

 (defn select-sketch []
   (let [hostname (.getHostName (java.net.InetAddress/getLocalHost))]
-    (get sketches (get installations (keyword hostname) :starfield)))) ;; :logo-countdown
+    (get sketches (get installations (keyword hostname) :logo-countdown))))

 (def active-sketch (atom {:sketch (select-sketch)
                           :expiration :never}))


Changed Mike Rosabal's role to DevOps

Changed Mike Rosabal's role to DevOps

--- src-cljs/frontend/components/about.cljs
+++ src-cljs/frontend/components/about.cljs
@@ -256,7 +256,7 @@
     :bio "Bio coming soon!"}
    {:name "Mike Rosabal"
     :img-path (scaled-image-path "mike-rosabal")
-    :role "Support Engineer"
+    :role "DevOps"
     :github ""
     :email ""
     :bio "Bio coming soon!"}


Remove CircleCI Version Info

Remove CircleCI Version Info

--- src-cljs/frontend/components/admin.cljs
+++ src-cljs/frontend/components/admin.cljs
@@ -72,20 +72,7 @@
     (render [_]
       (html
         [:section {:style {:padding-left "10px"}}
-         [:h1 "CircleCI Version Info"]
-         [:p
-          "You are running "
-          [:b
-           "CircleCI "
-           (if-let [enterprise-version (get-in app [:render-context :enterprise_version])]
-             (list
-              "Enterprise "
-              enterprise-version)
-             (list
-              "in "
-              (:environment app)))]
-          "."]
-
+         [:h1 "Active Users"]
          [:p (current-seat-usage (get-in app (conj state/license-path :seat_usage))
                                  (get-in app (conj state/license-path :seats)))
           " You can deactivate users in "


(SERVER-2218) Use valid class names in compilation tests

Previously we would create dummy classes in throwaway environments that
did not follow best practices for class naming. These became
deprecations at the end of the Puppet 5 series and will be errors in
Puppet 6.

This updates our mock class generation and expected output helpers to
create and test for class names that follow Puppet's best practices (and
won't err in the immediate future).

--- test/integration/puppetlabs/services/jruby/class_info_test.clj
+++ test/integration/puppetlabs/services/jruby/class_info_test.clj
@@ -1,5 +1,6 @@
 (ns puppetlabs.services.jruby.class-info-test
   (:require [clojure.test :refer :all]
+            [clojure.string :as str]
             [puppetlabs.kitchensink.core :as ks]
             [puppetlabs.services.jruby.jruby-puppet-testutils :as jruby-testutils]
             [puppetlabs.services.jruby.puppet-environments :as puppet-env]
@@ -9,9 +10,24 @@
             [puppetlabs.trapperkeeper.app :as tk-app]
             [puppetlabs.trapperkeeper.testutils.bootstrap :as tk-bootstrap]))

+(defn gen-module-classes
+  [[mod-dir manifests]]
+  (let [manifest-dir (fs/file mod-dir "manifests")
+        mod-name (fs/base-name mod-dir)]
+    (ks/mkdirs! manifest-dir)
+    (doseq [manifest manifests]
+      (spit (fs/file manifest-dir (str manifest ".pp"))
+            (str
+              "class " mod-name "::" manifest "($" manifest "_a, Integer $"
+              manifest "_b, String $" manifest
+              "_c = 'c default value') { }\n"
+              "class " mod-name "::" manifest "2($" manifest "2_a, Integer $"
+              manifest "2_b, String $" manifest
+              "2_c = 'c default value') { }\n")))))
+
 (defn gen-classes
-  [[mod-dir manifests]]
-  (let [manifest-dir (fs/file mod-dir "manifests")]
+  [[env-dir manifests]]
+  (let [manifest-dir (fs/file env-dir "manifests")]
     (ks/mkdirs! manifest-dir)
     (doseq [manifest manifests]
       (spit (fs/file manifest-dir (str manifest ".pp"))
@@ -35,31 +51,42 @@
       (cheshire/parse-string)))

 (defn expected-class-info
-  [class]
-    {"name" class
-     "params" [{"name" (str class "_a")}
-               {"name" (str class "_b"),
+  ([class-name]
+    {"name" class-name
+     "params" [{"name" (str class-name "_a")}
+               {"name" (str class-name "_b"),
                 "type" "Integer"}
-               {"name" (str class "_c"),
+               {"name" (str class-name "_c"),
                 "type" "String",
                 "default_literal" "c default value"
                 "default_source" "'c default value'"}]})
+  ([mod-name class-name]
+    {"name" (str mod-name "::" class-name)
+     "params" [{"name" (str class-name "_a")}
+               {"name" (str class-name "_b"),
+                "type" "Integer"}
+               {"name" (str class-name "_c"),
+                "type" "String",
+                "default_literal" "c default value"
+                "default_source" "'c default value'"}]}))

 (defn expected-manifests-info
   [manifests]
   (into {}
         (apply concat
                (for [[dir names] manifests]
-                 (do
-                   (for [name names]
+                 (let [mod-name (fs/base-name dir)]
+                   (for [class-name names]
                      [(.getAbsolutePath
                         (fs/file dir
                                  "manifests"
-                                 (str name ".pp")))
+                                 (str class-name ".pp")))
                       {"classes"
-                       [(expected-class-info name)
-                        (expected-class-info
-                         (str name "2"))]}]))))))
+                       (if (str/starts-with? mod-name "mod")
+                          [(expected-class-info mod-name class-name)
+                           (expected-class-info mod-name (str class-name "2"))]
+                          [(expected-class-info class-name)
+                           (expected-class-info (str class-name "2"))])}]))))))

 (deftest ^:integration class-info-test
   (testing "class info properly enumerated for"
@@ -94,25 +121,25 @@

              env-1-mod-dir (fs/file env-1-dir "modules")
              env-1-mod-1-dir-and-manifests [(fs/file env-1-mod-dir
-                                                     "envmod1")
-                                            ["envmod1baz" "envmod1bim"]]
-             _ (gen-classes env-1-mod-1-dir-and-manifests)
-             env-1-mod-2-dir (fs/file env-1-mod-dir "envmod2")
+                                                     "mod1env1")
+                                            ["baz" "bim"]]
+             _ (gen-module-classes env-1-mod-1-dir-and-manifests)
+             env-1-mod-2-dir (fs/file env-1-mod-dir "mod2env1")
              env-1-mod-2-dir-and-manifests [env-1-mod-2-dir
-                                            ["envmod2baz" "envmod2bim"]]
-             _ (gen-classes env-1-mod-2-dir-and-manifests)
+                                            ["baz" "bim"]]
+             _ (gen-module-classes env-1-mod-2-dir-and-manifests)

              env-3-dir-and-manifests [(env-dir "env3") ["dip" "dap" "dup"]]

              base-mod-dir (fs/file code-dir "modules")
-             base-mod-1-and-manifests [(fs/file base-mod-dir "basemod1")
-                                       ["basemod1bap"]]
-             _ (gen-classes base-mod-1-and-manifests)
+             base-mod-1-and-manifests [(fs/file base-mod-dir "mod1envbase")
+                                       ["bap"]]
+             _ (gen-module-classes base-mod-1-and-manifests)

              bogus-env-dir (env-dir "bogus-env")
              _ (create-env [bogus-env-dir []])
              _ (gen-classes [bogus-env-dir ["envbogus"]])
-             _ (gen-classes [(fs/file base-mod-dir "base-bogus") ["base-bogus1"]])
+             _ (gen-module-classes [(fs/file base-mod-dir "base-bogus") ["base-bogus1"]])

              get-class-info-for-env (fn [env]
                                       (-> (.getClassInfoForEnvironment jruby-puppet


fix reflection in acker

fix reflection in acker

--- src/clj/backtype/storm/daemon/acker.clj
+++ src/clj/backtype/storm/daemon/acker.clj
@@ -44,8 +44,7 @@
                             ACKER-ACK-STREAM-ID (update-ack curr (.getValue tuple 1))
                             ACKER-FAIL-STREAM-ID (assoc curr :failed true))]
                (.put pending id curr)
-               (when (and curr
-                          (:spout-task curr))
+               (when (and curr (:spout-task curr))
                  (cond (= 0 (:val curr))
                        (do
                          (.remove pending id)
@@ -74,16 +73,16 @@

 (defn -prepare [this conf context collector]
   (let [^IBolt ret (mk-acker-bolt)]
-    (container-set! (.state this) ret)
+    (container-set! (.state ^backtype.storm.daemon.acker this) ret)
     (.prepare ret conf context collector)
     ))

 (defn -execute [this tuple]
-  (let [^IBolt delegate (container-get (.state this))]
+  (let [^IBolt delegate (container-get (.state ^backtype.storm.daemon.acker this))]
     (.execute delegate tuple)
     ))

 (defn -cleanup [this]
-  (let [^IBolt delegate (container-get (.state this))]
+  (let [^IBolt delegate (container-get (.state ^backtype.storm.daemon.acker this))]
     (.cleanup delegate)
     ))


transition

transition

--- src/cljs/triboard/logic/transition.cljs
+++ src/cljs/triboard/logic/transition.cljs
@@ -30,19 +30,23 @@
   [owner]
   (or (= owner :none) (= owner :wall)))

-(defn- ^boolean is-source?
+(defn- ^boolean jump-start?
   [looser owner]
   (and looser (not= looser owner)))

-(defn- ^boolean? in-board?
+(defn- ^boolean in-board?
   [x y]
   (and (< -1 x board/width) (< -1 y board/height)))
+
+(defn- ^boolean empty-cell?
+  [board [x y]]
+  (= :none (aget board x y)))

 (defn- seek-jump-source-toward
   "Starting from the destination of a jump (a non-owned cell):
    * Search for valid source for the jump
    * Collect the jumped cells along the way"
-  [board [x-init y-init :as destination] [dx dy]]
+  [board [x-init y-init :as jump-destination] [dx dy]]
   (loop [x (+ x-init dx)
          y (+ y-init dy)
          looser nil
@@ -51,10 +55,10 @@
       (let [owner (aget board x y)]
         (cond
           (block-jump? owner) nil
-          (is-source? looser owner) {:winner owner
-                                     :looser looser
-                                     :destination destination
-                                     :taken taken}
+          (jump-start? looser owner) {:winner owner
+                                      :looser looser
+                                      :destination jump-destination
+                                      :taken taken}
           :else (recur
                   (+ x dx)
                   (+ y dy)
@@ -64,10 +68,10 @@

 (defn- available-jumps-at
   "Provides the list of moves that can be done from a cell"
-  [board [x y :as destination]]
-  (if (= :none (aget board x y))
+  [board jump-destination]
+  (if (empty-cell? board jump-destination)
     (eduction
-      (keep #(seek-jump-source-toward board destination %))
+      (keep #(seek-jump-source-toward board jump-destination %))
       cst/directions)))

 (defn- add-destination-jump


General hygeine; add docstrings, preconditions, etc.

--- src/com/puppetlabs/puppetdb/version.clj
+++ src/com/puppetlabs/puppetdb/version.clj
@@ -15,26 +15,43 @@
 ;; ### PuppetDB current version

 (defn version*
+  "Get the version number of this PuppetDB installation."
   []
+  {:post [(string? %)]}
   (version/get-version "puppetdb" "puppetdb"))

 (def version
+  "Get the version number of this PuppetDB installation."
   (memoize version*))

 ;; ### Utility functions for checking for the latest available version of PuppetDB

 (defn version-data*
-  "Build up a map of version data to be used in the 'latest version' check."
+  "Build up a map of version data to be used in the 'latest version' check.
+
+  `db` is a map containing the database connection info, in the format
+  used by `clojure.jdbc`."
   [db]
+  {:pre  [(map? db)]
+   :post [(map? %)]}
   (sql/with-connection db
-    {:database-name (scf-store/sql-current-connection-database-name)
+    {:database-name    (scf-store/sql-current-connection-database-name)
      :database-version (string/join "." (scf-store/sql-current-connection-database-version))}))

 (def version-data
+  "Build up a map of version data to be used in the 'latest version' check."
   (memoize version-data*))

 (defn update-info
+  "Make a request to the puppetlabs server to determine the latest available
+  version of PuppetDB.  Returns the JSON object received from the server, which
+  is expected to be a map containing keys `:version`, `:newer`, and `:link`.
+
+  Returns `nil` if the request does not succeed for some reason."
   [update-server db]
+  {:pre  [(string? update-server)
+          (map? db)]
+   :post [((some-fn map? nil?) %)]}
   (let [current-version        (version)
         version-data           (assoc (version-data db) :version current-version)
         query-string           (ring-codec/form-encode version-data)


Ignore case when sorting installed plugins

--- src/lt/objs/plugins.cljs
+++ src/lt/objs/plugins.cljs
@@ -520,7 +520,7 @@
                       (object/merge! app/app {::plugins (available-plugins)})
                       (let [ul (dom/$ :.plugins (object/->content this))]
                         (dom/empty ul)
-                        (dom/append ul (dom/fragment (map installed-plugin-ui (->> @app/app ::plugins vals (sort-by :name))))))))
+                        (dom/append ul (dom/fragment (map installed-plugin-ui (->> @app/app ::plugins vals (sort-by #(.toUpperCase (:name %))))))))))

 (behavior ::on-close
           :triggers #{:close}


use a sesnsible session ttl

use a sesnsible session ttl

--- dada-core/src/main/clojure/org/dada/core/SessionManagerImpl.clj
+++ dada-core/src/main/clojure/org/dada/core/SessionManagerImpl.clj
@@ -28,9 +28,9 @@
 (defn cleave [s f & i]
   (reduce (fn [[y n] e] (if (f e) [(conj y e) n] [y (conj n e)])) i s))

-(defn sweep-sessions [sessions]
+(defn sweep-sessions [sessions time-to-live]
   (trace "sweeping sessions")
-  (let [threshold (- (System/currentTimeMillis) 10000) ;TODO - hardwired
+  (let [threshold (- (System/currentTimeMillis) time-to-live)
 	[live dead] (swap2! sessions cleave (fn [^Session s] (> (.getLastPingTime s) threshold)) #{})]
     (if (not (empty? dead))
       (do
@@ -40,9 +40,13 @@
 ;;------------------------------------------------------------------------------

 (defn -init [^String name ^Model metamodel]
-  (let [sessions (atom #{})
+  (let [session-time-to-live (* 5 60 1000) ;TODO - hardwired
+	sessions (atom #{})
 	close-hooks (atom [])
-	^Timer timer (doto (Timer.) (.schedule (proxy [TimerTask][](run [] (sweep-sessions sessions))) 0 10000))] ;TODO - hardwired
+	^Timer timer (doto (Timer.)
+		       (.schedule
+			(proxy [TimerTask][](run [] (sweep-sessions sessions session-time-to-live)))
+			0 session-time-to-live))]
     [ ;; super ctor args
      []
      ;; instance state


added mastersign.files/file-name-ext function

--- src/mastersign/files.clj
+++ src/mastersign/files.clj
@@ -1,60 +1,68 @@
-(ns mastersign.files
-  (:import [java.net URL])
-  (:import [java.nio.file Paths Path Files CopyOption StandardCopyOption LinkOption])
-  (:import [java.nio.file.attribute FileAttribute]))
-
-(defn get-path
-  "Returs a `java.nio.file.Path` object for the given path.
-
-  The path is specified by a base `path` and optional
-  a number of additional `parts`.
-  The base path can be a string or a `java.net.URL`."
-  ^java.nio.file.Path
-  [path & parts]
-  (if (instance? URL path)
-    (Paths/get (.toURI ^URL path))
-    (Paths/get ^String path (if parts (into-array parts) (make-array String 0)))))
-
-(defn combine-path
-  "Returns a string with the specified path.
-
-  Uses the same interface like `get-path`."
-  ^String [path & parts]
-  (.toString ^Path (apply get-path (cons path parts))))
-
-(defn dir-name
-  "Returns a string with the path of the parent of the specified file / directory.
-
-  Uses the same interface like `get-path`."
-  ^String [path & parts]
-  (.toString ^Path (.getParent ^Path (apply get-path (cons path parts)))))
-
-(defn file-name
-  "Returns a string with the name of the specified file / directory.
-
-  Uses the same interface like `get-path`."
-  ^String [path & parts]
-  (.toString ^Path (.getFileName ^Path (apply get-path (cons path parts)))))
-
-(defn copy-file
-  "Copies a file from a given `source` path to the `target` path.
-
-  The source and target path need to be `java.nio.file.Path` objects."
-  [^Path source ^Path target]
-  (Files/copy source target (into-array CopyOption [StandardCopyOption/REPLACE_EXISTING])))
-
-(defn create-dir
-  "Creates a directory including all non existing parent directories.
-
-  Uses the same interface like `get-path`."
-  [path & parts]
-  (let [path (apply get-path (cons path parts))]
-    (Files/createDirectories path (make-array FileAttribute 0))))
-
-(defn file-exists?
-  "Checks if the specified file exists.
-
-  Uses the same interface like `get-path`."
-  [path & parts]
-  (let [path (apply get-path (cons path parts))]
-    (Files/exists path (make-array LinkOption 0))))
+(ns mastersign.files
+  (:import [java.net URL])
+  (:import [java.nio.file Paths Path Files CopyOption StandardCopyOption LinkOption])
+  (:import [java.nio.file.attribute FileAttribute]))
+
+(defn get-path
+  "Returs a `java.nio.file.Path` object for the given path.
+
+  The path is specified by a base `path` and optional
+  a number of additional `parts`.
+  The base path can be a string or a `java.net.URL`."
+  ^java.nio.file.Path
+  [path & parts]
+  (if (instance? URL path)
+    (Paths/get (.toURI ^URL path))
+    (Paths/get ^String path (if parts (into-array parts) (make-array String 0)))))
+
+(defn combine-path
+  "Returns a string with the specified path.
+
+  Uses the same interface like `get-path`."
+  ^String [path & parts]
+  (.toString ^Path (apply get-path (cons path parts))))
+
+(defn dir-name
+  "Returns a string with the path of the parent of the specified file / directory.
+
+  Uses the same interface like `get-path`."
+  ^String [path & parts]
+  (.toString ^Path (.getParent ^Path (apply get-path (cons path parts)))))
+
+(defn file-name
+  "Returns a string with the name of the specified file / directory.
+
+  Uses the same interface like `get-path`."
+  ^String [path & parts]
+  (.toString ^Path (.getFileName ^Path (apply get-path (cons path parts)))))
+
+(defn file-name-ext
+  "Returns the extension of the given file name or nil if the name has no extension.
+
+  Uses the same interface like `get-path`."
+  ^String [path & parts]
+  (let [n (apply file-name path parts)]
+    (re-find #"\.[^\.]+$" n)))
+
+(defn copy-file
+  "Copies a file from a given `source` path to the `target` path.
+
+  The source and target path need to be `java.nio.file.Path` objects."
+  [^Path source ^Path target]
+  (Files/copy source target (into-array CopyOption [StandardCopyOption/REPLACE_EXISTING])))
+
+(defn create-dir
+  "Creates a directory including all non existing parent directories.
+
+  Uses the same interface like `get-path`."
+  [path & parts]
+  (let [path (apply get-path (cons path parts))]
+    (Files/createDirectories path (make-array FileAttribute 0))))
+
+(defn file-exists?
+  "Checks if the specified file exists.
+
+  Uses the same interface like `get-path`."
+  [path & parts]
+  (let [path (apply get-path (cons path parts))]
+    (Files/exists path (make-array LinkOption 0))))


Implement full-featured table component #45 - cell-by-cell and direct selection implementations

--- src/flatgui/samples/forms/tablewin2.clj
+++ src/flatgui/samples/forms/tablewin2.clj
@@ -105,7 +105,9 @@
    :background (awt/color 32 16 8)
    :evolvers {:header-model-loc table/shift-header-model-loc-evolver
               :clip-size scrollpanel/scrollpanelcontent-clip-size-evolver
-              :selection table/selection-evolver}}
+              ;:selection table/direct-selection
+              :selection table/cbc-selection
+              }}
   scrollpanel/scrollpanelcontent table/table)

 (def table-window


Will no longer crash if port number not supplied at command line. Added option to disable Java AWT.

--- src/hackerati_interval_web_app/core.clj
+++ src/hackerati_interval_web_app/core.clj
@@ -1,4 +1,6 @@
 ; Run test server with `lein ring server-headless`
+; Run -main with `lein run 3000`
+; If lein run is crashing, you are probably forgetting the port number.
 (ns hackerati-interval-web-app.core
   (:require  [compojure.core :refer :all]
              [compojure.handler :as handler]
@@ -17,6 +19,7 @@
   (GET "/link/:productid" request (views/link-view request))
   (GET "/login" {session :session}  (views/not-logged-in session))
   (POST "/login" request (views/login request))
+  (POST "/newlink" request (str request))
   (POST "/register" request (views/attempt-register request))
   (GET "/test" request (views/session-test request))
   (route/resources "/bootstrap")
@@ -36,8 +39,13 @@

 ;; Scheduled task must go first, otherwise won't get executed.
 (defn -main [& [port]]
-  (scheduled-task db/refresh-prices)
-  (jetty/run-jetty app
-                   {:port (if port
-                            (Integer/parseInt port)
-                            (Integer/parseInt (System/getenv "PORT")))}))
+  (if-let [port (try
+                  (Integer/parseInt port)
+                  (catch Exception e))]
+    (do
+      (System/setProperty "java.awt.headless" "true")
+      (scheduled-task db/refresh-prices)
+      (jetty/run-jetty app
+                      {:port port :auto-reload? true}))
+    (println "Useage: lein run port")))
+


less iterations for list comprehension benchmarks

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -222,10 +222,10 @@
 (println)

 (println ";;; comprehensions")
-(simple-benchmark [xs (range 512)] (last (for [x xs y xs] (+ x y))) 10)
-(simple-benchmark [xs (vec (range 512))] (last (for [x xs y xs] (+ x y))) 10)
-(simple-benchmark [a (Box. 0) xs (range 512)] (doseq [x xs y xs] (set! a -val (+ (.-val a) x))) 100)
-(simple-benchmark [a (Box. 0) xs (vec (range 512))] (doseq [x xs y xs] (set! a -val (+ (.-val a) x))) 100)
+(simple-benchmark [xs (range 512)] (last (for [x xs y xs] (+ x y))) 1)
+(simple-benchmark [xs (vec (range 512))] (last (for [x xs y xs] (+ x y))) 4)
+(simple-benchmark [a (Box. 0) xs (range 512)] (doseq [x xs y xs] (set! a -val (+ (.-val a) x))) 4)
+(simple-benchmark [a (Box. 0) xs (vec (range 512))] (doseq [x xs y xs] (set! a -val (+ (.-val a) x))) 4)
 (println)

 (println "\n")


Handle s/enum types when sanitizing input before validation

--- src/io/aviso/rook/schema_validation.clj
+++ src/io/aviso/rook/schema_validation.clj
@@ -3,6 +3,7 @@
   this :schema meta-data key of the targetted function, if non-nil, is used to
   validate the incoming data."
   (:import (javax.servlet.http HttpServletResponse)
+           (schema.core EnumSchema)
            (clojure.lang IPersistentMap))
   (:require
     [schema.core :as s]
@@ -24,6 +25,9 @@

   ;; Non-matches are passed through unchanged.
   Object
+  (sanitize [_ data] data)
+
+  EnumSchema
   (sanitize [_ data] data)

   IPersistentMap


working on targets-v2

working on targets-v2

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -44,10 +44,13 @@
               (write-str {:source (get-in gcacs [:source])
                           :target_spec target_spec
                           ;; TODO: eventually add :source-v2
+                          :gcacs gcacs
                           :targets (get-in gcacs [:targets])
-                          :targets-v2 [{:surface "some italian stuff one"
-                                        :roots ["italian","stuff"]}]}))})
-
+                          :targets-v2
+                          (map (fn [surface]
+                                 {:surface surface
+                                  :roots ["foo","bar"]})
+                               (get-in gcacs [:targets]))}))})
       (GET "/:expr" request
            (let [expr (:expr (:route-params request))]
              (log/debug (str "expr(1):" expr))


Include the XML declaration at the top of a rendered view

--- src/main/clojure/cascade/dispatcher.clj
+++ src/main/clojure/cascade/dispatcher.clj
@@ -106,8 +106,10 @@
         ; since need to force side effects before calling prepare-dom-for-render
         _ (force-dom dom)
         prepared (prepare-dom-for-render env dom)]
-    (debug "Streaming XML response")
-    (with-open [writer (.getWriter response)]
+    (debug "Streaming XML response")
+    (.setContentType response "text/html")
+    (with-open [writer (.getWriter response)]
+      (.write out "<?xml version=\"1.0\"?>\n")
       (render-xml prepared writer)))
   true)


Put all predicates on top of the file.

Put all predicates on top of the file.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -4,6 +4,27 @@
             [cats.context :as ctx])
   (:refer-clojure :exclude [true? map filter reduce merge repeat repeatedly zip
                             dedupe drop take take-while concat partition]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Predicates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn observable?
+  "Return true if `ob` is a instance
+  of Rx.Observable."
+  [ob]
+  (instance? js/Rx.Observable ob))
+
+(defn connectable?
+  "Return true if `ob` is a instance
+  of Rx.ConnectableObservable."
+  [ob]
+  (instance? js/Rx.ConnectableObservable ob))
+
+(defn bus?
+  "Return true if `b` is a Subject instance."
+  [b]
+  (instance? js/Rx.Subject b))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Observables Constructors
@@ -125,12 +146,6 @@
   (create (fn [sink]
             (sink nil))))

-(defn observable?
-  "Return true if `ob` is a instance
-  of Rx.Observable."
-  [ob]
-  (instance? js/Rx.Observable ob))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Bus
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -140,11 +155,6 @@
   values into the stream."
   []
   (js/Rx.Subject.))
-
-(defn bus?
-  "Return true if `b` is a Subject instance."
-  [b]
-  (instance? js/Rx.Subject b))

 (defn push!
   "Pushes the given value to the bus stream."


Changed the way to calculate the torrent total size in order to return a more accurate number.

--- src/bencode/main.clj
+++ src/bencode/main.clj
@@ -20,8 +20,8 @@
   (/ (count (torrent-pieces torrent)) 20))

 (defn torrent-size [torrent]
-  (* (torrent-piece-length torrent)
-     (count-torrent-pieces torrent)))
+  (reduce + (map #(get % "length")
+                 (get-in torrent ["info" "files"]))))

 (defn hex-from-bytes [byte-arr]
   (let [sb (StringBuffer.)]


remove unused pprint :require

remove unused pprint :require

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -2,7 +2,6 @@
   (:require
    [clojure.java.io          :as io]
    [clojure.set              :as set]
-   [clojure.pprint           :as pprint]
    [clojure.string           :as string]
    [boot.pod                 :as pod]
    [boot.file                :as file]


match on starting sequence of manufacturer and title

--- src/blx/sortable.clj
+++ src/blx/sortable.clj
@@ -1,6 +1,13 @@
 (ns blx.sortable
-  (:require [cheshire.core :as json])
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [cheshire.core :as json])
   (:gen-class))
+
+(def conf
+  {:products-uri "resources/data/products.txt"
+   :listings-uri "resources/data/listings.txt"
+   :out-uri "results.json"})

 ; Product :: {:product_name str
 ;             :manufacturer str
@@ -16,24 +23,90 @@
 ; Result :: {:product_name str
 ;            :listings [Listing]}

-(defn load-json [path]
-  (-> path
-      clojure.java.io/reader
-      (json/parse-stream true)))
+(defn- parse-json [s]
+  (json/parse-string s true))

-(defn match-products
-  [products listings]
-  ...)
+(defn load-input [path]
+  (with-open [rdr (io/reader path)]
+    (->> (line-seq rdr)
+         (mapv parse-json))))
+
+(defn prepare-product [product]
+  (-> product
+      (update :product_name #(str/replace % #"[_-]" " "))))
+
+
+; misfire: got "Samsung PL100" for listing "Samsung PL 120 purple"
+
+
+(defn longest-starting-match [a b]
+  (->> (map vector a b)
+       (reduce (fn [match-len [a b]]
+                 (if (= a b)
+                   (inc match-len)
+                   (reduced match-len)))
+               0)))

+(defn match-manufacturer [mproducts listing]
+  (->> (keys mproducts)
+       (some #(when (.startsWith (:manufacturer listing) %)
+                %))))
+
+(defn match-title [products listing]
+  (let [min-match-len 3
+        matches (->> products
+                     (map #(vector (longest-starting-match (:title listing)
+                                                           (:product_name %))
+                                   %))
+                     (sort-by first >)
+                     (filter #(> (first %) min-match-len))
+                     (take 3))]
+    matches))
+
+(defn match' [products listing]
+  (println "Trying to match " listing)
+  (let [mproducts (group-by :manufacturer products)
+        est-manufacturer (match-manufacturer mproducts listing)
+        est-products (match-title products listing)]
+    [est-manufacturer est-products]))
+
+
+(def match-threshold 20)
+
+(def match-preds
+  [[(fn [products listing]
+      (some #(.startsWith (:manufacturer listing) %)
+            (map :manufacturer products)))
+    20]])
+
+
+(defn match-product
+  "Returns the product matched by listing, or nil if no match."
+  [products listing]
+  (let [score-seq (map (fn [[pred weight]]
+                         (when (pred listing)
+                           weight))
+                       match-preds)]
+    (reduce (fn [score x]
+              (let [score' (+ score x)]
+                (if (>= score' match-threshold)
+                  (reduced score')
+                  score')))
+            0 score-seq)))
+
+

 (defn -main
-  "I don't do a whole lot ... yet."
   [& args]
-  (let [products (load-json "resources/data/products.txt")
-        listings (load-json "resources/data/listings.txt")
-        out "results.json"]
-    (-> (match-products products listings)
-        (json/generate-stream (clojure.java.io/writer out)))))
+  ; We need to read all products into memory, but we
+  ; can process listings lazily / line-by-line.
+  (let [products (mapv prepare-product (load-input (:products-uri conf)))]
+    (with-open [listings (io/reader (:listings-uri conf))
+                out (io/writer (:out-uri conf))]
+      (doseq [result (->> (line-seq listings)
+                          (map parse-json)
+                          (map #(match-product products %)))]
+        (json/generate-stream result out)))))


Output correct product name, before we mangled it for searching

--- src/blx/sortable.clj
+++ src/blx/sortable.clj
@@ -7,7 +7,7 @@
 (def conf
   {:products-uri "resources/data/products.txt"
    :listings-uri "resources/data/listings.txt"
-   :out-uri "results.json"})
+   :out-uri      "results.txt"})

 ; Product :: {:product_name str
 ;             :manufacturer str
@@ -44,6 +44,7 @@

 (defn prepare-product [product]
   (-> product
+      (#(assoc % :formatted-name (:product_name %)))
       (update :product_name normalize-str)
       (update :model normalize-str)))

@@ -101,7 +102,7 @@
     (->> matches
          (group-by second)
          (map (fn [[prod matching-listings]]
-                {:product_name (:product_name prod)
+                {:product_name (:formatted-name prod)
                  :listings (map first matching-listings)})))))


fixed compile bug ..

fixed compile bug ..

--- main/src/dda/pallet/dda_serverspec_crate/infra/test/command.clj
+++ main/src/dda/pallet/dda_serverspec_crate/infra/test/command.clj
@@ -22,7 +22,7 @@

 (def CommandTestConfig {s/Keyword {:exit-status s/Num}})

-(s/def fact-check :- server-test/TestResult
+(s/defn fact-check :- server-test/TestResult
   "Compare facts & expectation in order to return test-results."
   [result :- server-test/TestResult
    spec :- CommandTestConfig


yay-er

yay-er

--- src/metabase/driver/query_processor.clj
+++ src/metabase/driver/query_processor.clj
@@ -1,6 +1,7 @@
 (ns metabase.driver.query-processor
   "Preprocessor that does simple transformations to all incoming queries, simplifing the driver-specific implementations."
   (:require [clojure.core.match :refer [match]]
+            [clojure.string :as s]
             [clojure.tools.logging :as log]
             [korma.core :refer :all]
             [medley.core :as m]
@@ -385,20 +386,18 @@
             ;; If col-kw is a known Field return that
             (field-kw->field col-kw)
             ;; Otherwise it is an aggregation column like :sum, build a map of information to return
-            (let [ag-type (keyword ag-type)]
-              (assert ag-type)
-              (merge {:name        (name col-kw)
-                      :id          nil
-                      :table_id    nil
-                      :description nil}
-                     (let [ag-type (keyword ag-type)]
-                       (cond
-                         ;; avg, stddev, and sum should inherit the base_type and special_type from the Field they're aggregating
-                         (contains? #{:avg :stddev :sum} ag-type) (-> (@field-id->field ag-field-id)
-                                                                      (select-keys [:base_type :special_type]))
-                         ;; count should always be IntegerField/number
-                         (= ag-type :count)                       {:base_type    :IntegerField
-                                                                   :special_type :number}))))))
+            (merge (assert ag-type)
+                   {:name        (name col-kw)
+                    :id          nil
+                    :table_id    nil
+                    :description nil}
+                   (cond
+                     ;; avg, stddev, and sum should inherit the base_type and special_type from the Field they're aggregating
+                     (contains? #{:avg :stddev :sum} col-kw) (-> (@field-id->field ag-field-id)
+                                                                 (select-keys [:base_type :special_type]))
+                     ;; count should always be IntegerField/number
+                     (= col-kw :count)                       {:base_type    :IntegerField
+                                                              :special_type :number}))))
          ;; Add FK info the the resulting Fields
          add-fields-extra-info)))


Cosmetic.

Cosmetic.

--- src/onyx/log/commands/complete_task.clj
+++ src/onyx/log/commands/complete_task.clj
@@ -4,7 +4,7 @@
             [onyx.extensions :as extensions]))

 (defmethod extensions/apply-log-entry :complete-task
-  [{:keys [args message-id]} replica]
+  [{:keys [args]} replica]
   (let [peers (get-in replica [:allocations (:job args) (:task args)])]
     (-> replica
         (update-in [:completions (:job args)] conj (:task args))


Basic session middleware.

Basic session middleware.

--- src/philly_show_checker/server/core.clj
+++ src/philly_show_checker/server/core.clj
@@ -15,9 +15,9 @@
   (println (format "starting nrepl on port %s" port)))

 (k-dsl/defweb :philly-show-checker-api-v1
-  :mount-point "/"
+  :mount-point "/v1/"
   :app-ns-prefix :philly-show-checker.server.api.v1
-  :before-middleware [#(session/wrap-session % (session-cookie/cookie-store {:key "0b9d0d8b990d4ade"}))])
+  :before-middleware [#(session/wrap-session % {:store (session-cookie/cookie-store {:key "0b9d0d8b990d4ade"})})])

 (defonce stop-server-fn (atom nil))

@@ -38,3 +38,4 @@
 (comment
   (start-webserver 6888)
   )
+


Work on Welcome panel

Work on Welcome panel

--- src/re_demo/welcome.cljs
+++ src/re_demo/welcome.cljs
@@ -1,12 +1,50 @@
 (ns re-demo.welcome
-  (:require [re-com.core   :refer [h-box v-box box gap line title label hyperlink-href]]
+  (:require [re-com.core   :refer [h-box v-box box gap line title label hyperlink-href input-text]]
             [re-demo.utils :refer [panel-title component-title paragraphs]]))
+
+(defn named-params
+  []
+  [v-box
+   :children [
+              [title :level :level2 :label "Named Parameters"]
+
+               [:p {:width "60em"} "re-com components take " [:code "named parameters"] ", rather than " [:code "positional parameters"] ]
+               [:p {:width "60em"}"When you use a re-com component like " [:code "checkbox"] ", you will not be asked to use positional parameters like this:"
+               [:pre {:width "60em"} "[checkbox
+               \"Show Status Icon?\"
+               status-icon?
+               (fn [new-val] (reset! status-icon? new-val))]"]
+               ]
+              [:pre
+               {:style {:width "40em"}}
+               "[checkbox
+  :label     \"Show Status Icon?\" "
+               [input-text  :model "hello" :on-change #()]
+
+               "
+  :model     status-icon?      ; a ratom
+  :on-change (fn [new-val] (reset! status-icon? new-val))]"]]])
+
+
+(defn this-app
+  []
+  [v-box
+   :children [
+              [title :level :level2 :label "This app"]
+              [gap :size "5px"]
+              [:p "The demo app serves as:"
+               [:ul
+                [:li "a visual showcase of the components"]
+                [:li "coding demos for using the components"]
+                [:li "documentation for the components (parameters etc.)"]
+                [:li "a harness for testing"]]]]])

 (defn panel2
   []
   [v-box
    :size     "auto"
+   :width    "600px"
    :children [[panel-title "Welcome"]
               [gap :size "15px"]
               [paragraphs
@@ -17,25 +55,15 @@
                  :href "https://github.com/reagent-project/reagent"
                  :target "_blank"]
                 "."]
-               [:p "It contains some of layout and widgetry needed to build a desktop-class app."]
+               [:p "It contains the sort of layout and controls you'd need to build a desktop-class app."]]
                [gap :size "10px"]
-               [title :level :level2 :label "This app"]
-               [gap :size "5px"]
-               [:p "The demo app serves as:"
-                [:ul
-                 [:li "a visual showcase of the components"]
-                 [:li "coding demos for using the components"]
-                 [:li "documentation for the components (parameters etc.)"]
-                 [:li "a harness for testing"]
-                 ]]
-               [title :level :level2 :label "Named Parameters"]
-               [:pre
-                {:style {:width "40em"}}
-                "[checkbox
- :label     \"Show Status Icon?\"
- :model     status-icon?      ; a ratom
- :on-change (fn [new-val] (reset! status-icon? new-val))]"]
-               ]]])
+               [this-app]
+               [gap :size "10px"]
+               [line]
+               [named-params]
+
+
+               ]])


Try to add localstorage middleware. Failed because keywords are turned into strings. Duh!

--- examples/todomvc/src/todomvc/handlers.cljs
+++ examples/todomvc/src/todomvc/handlers.cljs
@@ -1,16 +1,18 @@
 (ns todomvc.handlers
   (:require
-    [todomvc.db    :refer [default-value valid-schema? get-local-storage]]
+    [todomvc.db    :refer [default-value valid-schema?
+                           get-local-storage set-local-storage!]]
     [re-frame.core :refer [register-pure-handler
                            path after
-                           trim-v
-                           debug validate]]))
+                           trim-v debug]]))

 ;; -- Middleware --------------------------------------------------------------
 ;;
 ;; checks that the structure in app-db matches the schema
 (def check-schema (after valid-schema?))
+
+(def write-ls (after set-local-storage!))

 ;; middleware for any handler which manipulates todos.
 (def todo-middleware [check-schema (path [:todos])  debug  trim-v])
@@ -22,7 +24,7 @@
   [todos]
   (if (empty? todos)
     0
-    (inc (apply max (keys todos)))))  ;; hillariously inefficient, but yeah
+    (inc (last (keys todos)))))

 ;; -- Handlers ----------------------------------------------------------------
@@ -37,7 +39,7 @@

 (register-pure-handler            ;; handlers changes the footer filter
   :set-showing                    ;; event-id
-  [check-schema debug trim-v]     ;; middleware  (wraps the handler)
+  [write-ls check-schema debug trim-v]     ;; middleware  (wraps the handler)
   (fn                             ;; handler
     [db [filter-kw]]
     (assoc db :showing filter-kw)))


Added Mersenne Twister configuration.

Added Mersenne Twister configuration.

--- src/clj/pdp/core.clj
+++ src/clj/pdp/core.clj
@@ -7,3 +7,8 @@
   (:gen-class))

 (load "core/graph")
+
+;; (def ^java.util.Random rnd
+;;   (let [seed (byte-array 16)]
+;;     (aset ^bytes seed 0 (byte 1))
+;;     (org.uncommons.maths.random.MersenneTwisterRNG. seed)))


[Delete] type annotation

[Delete] type annotation

--- src/clj_elm/data.clj
+++ src/clj_elm/data.clj
@@ -8,74 +8,74 @@

 (defrecord DataSet [classes features])

-(defn ^clojure.lang.PersistentVector parse-lib-svm-data
-  ([^clojure.lang.PersistentVector line]
+(defn parse-lib-svm-data
+  ([line]
    {:pre [(integer? (first line)) (map? (last line))]}
    (let [[class featmap] line
          fnum (count featmap)
          features (map #(get featmap %) (range 1 (inc fnum)))]
      [class features])))

-(defn ^DataSet data-set
+(defn data-set
   "Make DataSet from incanter-form or csv dataset. Cidx is column number of class."
-  ([^incanter.core.Dataset dataset ^Integer cidx]
+  ([cidx]
    {:pre [(c/dataset? dataset)]}
    (DataSet. (pmap int (c/to-vect (c/$ :all cidx dataset))) (c/to-vect (c/$ [:not cidx] dataset)))))

-(defn ^DataSet read-dataset
-  ([^String path ^Integer cidx & {:keys [^Boolean header] :or {header false}}]
+(defn read-dataset
+  ([& {:keys [header] :or {header false}}]
    {:pre [(string? path) (integer? cidx)]}
    (-> (io/read-dataset path :delim \, :header header)
        (data-set cidx))))

-(defn ^DataSet read-dataset-lib-svm
-  ([^String path]
+(defn read-dataset-lib-svm
+  ([path]
    {:pre [(string? path)]}
    (->> (svm/read-dataset path)
         (pmap parse-lib-svm-data)
         (#(DataSet. (map first %) (map second %))))))

-(defn ^DataSet concat-dataset
-  ([^DataSet dsa ^DataSet dsb]
+(defn concat-dataset
+  ([dsb]
    {:pre [(instance? DataSet dsa) (instance? DataSet dsb)]}
    (DataSet. (concat (:classes dsa) (:classes dsb))
              (concat (:features dsa) (:features dsb)))))

-(defn ^DataSet shuffle-dataset
-  ([^DataSet dataset]
+(defn shuffle-dataset
+  ([dataset]
    {:pre [(instance? DataSet dataset)]}
    (-> (pmap vector (:classes dataset) (:features dataset))
        (shuffle)
        (#(DataSet. (pmap first %) (pmap second %))))))

-(defn ^Integer num-of-feature
-  ([^DataSet dataset]
+(defn num-of-feature
+  ([dataset]
    {:pre [(coll? dataset)]}
    (count (first (:features dataset)))))

 (defn ith-feature-list
-  ([^DataSet dataset ^Integer i]
+  ([i]
    {:pre [(coll? dataset) (integer? i)]}
    (c/$ i (c/to-dataset dataset))))

-(defn ^clojure.lang.PersistentVector each-ith-f
-  ([f ^DataSet dataset]
+(defn each-ith-f
+  ([f dataset]
    (->> (range 0 (count (first dataset)))
         (pmap #(f (ith-feature-list dataset %)))
         (vec))))

-(defn ^clojure.lang.PersistentVector each-ith-mean
-  ([^DataSet dataset]
+(defn each-ith-mean
+  ([dataset]
    {:pre [(coll? dataset)]}
    (each-ith-f st/mean dataset)))

-(defn ^clojure.lang.PersistentVector each-ith-sd
-  ([^DataSet dataset]
+(defn each-ith-sd
+  ([dataset]
    {:pre [(coll? dataset)]}
    (each-ith-f st/sd dataset)))

-(defn ^clojure.lang.PersistentVector normalize
-  ([^DataSet dataset]
+(defn
+  ([dataset]
    {:pre [(coll? dataset)]}
    (let [means (each-ith-mean dataset)
          sds (each-ith-sd dataset)]
@@ -83,12 +83,12 @@
           (pmap #(map - % means))
           (pmap #(map / % sds))))))

-(defn ^clojure.lang.PersistentVector remove-list
-  ([^clojure.lang.PersistentVector lst ^Integer a ^Integer b]
+(defn remove-list
+  ([b]
    {:pre [(coll? lst) (integer? a) (integer? b) (> b a)]}
    (concat (take a lst) (drop (inc b) lst))))

-(defn ^clojure.lang.PersistentVector extract-list
-  ([^clojure.lang.PersistentVector lst ^Integer a ^Integer b]
+(defn extract-list
+  ([b]
    {:pre [(coll? lst) (integer? a) (integer? b) (> b a)]}
    (take (inc (- b a)) (drop a lst))))


Using reflect.DeepEqual for identical? which is wrong, but kind of works

--- src/cljs/go/core.clj
+++ src/cljs/go/core.clj
@@ -333,7 +333,7 @@
   (bool-expr (core/list 'js* "(nil == ~{})" x)))

 (defmacro identical? [a b]
-  (bool-expr (core/list 'js* "(~{} == ~{})" a b)))
+  (bool-expr (core/list 'js* "reflect.DeepEqual(~{}, ~{})" a b))) ;; this is wrong, but kind of works

 (defmacro instance? [t o]
   ;; Google Closure warns about some references to RegExp, so


Cleanup SVG docs.

Cleanup SVG docs.

--- src/cljx/c2/svg.cljx
+++ src/cljx/c2/svg.cljx
@@ -1,3 +1,6 @@
+;;Collection of helpers for dealing with scalable vector graphics.
+;;
+;;Coordinates to any fn can be 2-vector `[x y]` or map `{:x x :y y}`.
 ^:clj (ns c2.svg
         (:use [c2.maths :only [Pi Tau radians-per-degree
                                sin cos]]
@@ -10,11 +13,16 @@
          (:require [c2.dom :as dom]))

-;;Lil' SVG helpers
+(defn ->xy
+  "Convert coordinates (potentially map of `{:x :y}`) to 2-vector."
+  [coordinates]
+  (match [coordinates]
+         [[x y]] [x y]
+         [{:x x :y y}] [x y]))
+
 (defn translate [coordinates]
-  (match [coordinates]
-         [[x y]] (str "translate(" x "," y ")")
-         [{:x x :y y}] (recur [x y])))
+  (let [[x y]] (->xy coordinates)
+       (str "translate(" x "," y ")")))

 (defn scale [coordinates]
   (match [coordinates]
@@ -24,8 +32,8 @@

 (defn ^:cljs get-bounds
-  "Returns map of {:x :y :width :height} containing SVG element bounding box.
-   All coordinates are in userspace. See: http://www.w3.org/TR/SVG/types.html#InterfaceSVGLocatable"
+  "Returns map of `{:x :y :width :height}` containing SVG element bounding box.
+   All coordinates are in userspace. Ref [SVG spec](http://www.w3.org/TR/SVG/types.html#InterfaceSVGLocatable)"
   [$svg-el]
   (let [b (.getBBox $svg-el)]
     {:x (.-x b)
@@ -34,7 +42,7 @@
      :height (.-height b)}))

 (defn transform-to-center
-  "Returns a transform string that will scale and center provided element {:width :height :x :y} within container {:width :height}."
+  "Returns a transform string that will scale and center provided element `{:width :height :x :y}` within container `{:width :height}`."
   [element container]
   (let [{ew :width eh :height x :x y :y} element
         {w :width h :height} container
@@ -47,7 +55,7 @@

 (defn ^:cljs transform-to-center!
-  "Scales and centers $svg-el within its parent SVG container.
+  "Scales and centers `$svg-el` within its parent SVG container.
    Uses parent's width and height attributes only."
   [$svg-el]
   (let [$svg (.-ownerSVGElement $svg-el)
@@ -59,8 +67,18 @@

 (defn axis
-  "Returns axis <g> for input scale with ticks.
-Direction away from the data frame is defined to be positive; use negative margins and widths for the axis to render inside of the data frame"
+  "Returns axis <g> hiccup vector for provided input `scale` and collection of `ticks` (numbers).
+   Direction away from the data frame is defined to be positive; use negative margins and widths to render axis inside of data frame.
+
+   Kwargs:
+
+   > *:orientation* ∈ (`:top`, `:bottom`, `:left`, `:right`), where the axis should be relative to the data frame, defaults to `:left`
+
+   > *:formatter* fn run on tick values, defaults to `str`
+
+   > *:major-tick-width* width of ticks (minor ticks not yet implemented), defaults to 6
+
+   > *:text-margin* distance between axis and start of text, defaults to 9"
   [scale ticks & {:keys [orientation
                          formatter
                          major-tick-width
@@ -90,14 +108,16 @@
 (def ArcMax (- Tau 0.0000001))

 (defn circle
-  "Returns svg path data for a circle starting at 3 o'clock and sweeping in positive y."
+  "Calculate SVG path data for a circle of `radius` starting at 3 o'clock and sweeping in positive y."
   ([radius] (circle [0 0] radius))
-  ([[x y] radius]
-     (str "M"  (+ x radius) "," y
-          "A" (+ x radius) "," (+ y radius) " 0 1,1" (- (+ x radius)) "," y
-          "A" (+ x radius) "," (+ y radius) " 0 1,1" (+ x radius) "," y)))
+  ([coordinates radius]
+     (let [[x y] (->xy coordinates)]
+       (str "M"  (+ x radius) "," y
+            "A" (+ x radius) "," (+ y radius) " 0 1,1" (- (+ x radius)) "," y
+            "A" (+ x radius) "," (+ y radius) " 0 1,1" (+ x radius) "," y))))

 (defn arc
+  "Calculate SVG path data for an arc."
   [& {:keys [inner-radius, outer-radius
              start-angle, end-angle, angle-offset]
       :or {inner-radius 0, outer-radius 1


adding end game, move board and player side-by-side, clean up

--- cartagena-web/src/cartagena_web/main.cljs
+++ cartagena-web/src/cartagena_web/main.cljs
@@ -3,144 +3,6 @@
             [ajax.core :as ajax]))

 (enable-console-print!)
-
-(def initial-game-state {:board [{:index 0,
-                                  :icon :jail,
-                                  :pirates [:orange :orange :orange :orange :orange :orange :black :black :black :black :black :black]}
-                                 {:index 1, :icon :key, :pirates []}
-                                 {:index 2, :icon :knife, :pirates []}
-                                 {:index 3, :icon :skull, :pirates []}
-                                 {:index 4, :icon :hat, :pirates []}
-                                 {:index 5, :icon :gun, :pirates []}
-                                 {:index 6, :icon :bottle, :pirates []}
-                                 {:index 7, :icon :skull, :pirates []}
-                                 {:index 8, :icon :hat, :pirates []}
-                                 {:index 9, :icon :gun, :pirates []}
-                                 {:index 10, :icon :key, :pirates []}
-                                 {:index 11, :icon :bottle, :pirates []}
-                                 {:index 12, :icon :knife, :pirates []}
-                                 {:index 13, :icon :hat, :pirates []}
-                                 {:index 14, :icon :key, :pirates []}
-                                 {:index 15, :icon :gun, :pirates []}
-                                 {:index 16, :icon :bottle, :pirates []}
-                                 {:index 17, :icon :skull, :pirates []}
-                                 {:index 18, :icon :knife, :pirates []}
-                                 {:index 19, :icon :gun, :pirates []}
-                                 {:index 20, :icon :hat, :pirates []}
-                                 {:index 21, :icon :knife, :pirates []}
-                                 {:index 22, :icon :skull, :pirates []}
-                                 {:index 23, :icon :bottle, :pirates []}
-                                 {:index 24, :icon :key, :pirates []}
-                                 {:index 25, :icon :gun, :pirates []}
-                                 {:index 26, :icon :key, :pirates []}
-                                 {:index 27, :icon :knife, :pirates []}
-                                 {:index 28, :icon :hat, :pirates []}
-                                 {:index 29, :icon :skull, :pirates []}
-                                 {:index 30, :icon :bottle, :pirates []}
-                                 {:index 31, :icon :skull, :pirates []}
-                                 {:index 32, :icon :gun, :pirates []}
-                                 {:index 33, :icon :bottle, :pirates []}
-                                 {:index 34, :icon :key, :pirates []}
-                                 {:index 35, :icon :knife, :pirates []}
-                                 {:index 36, :icon :hat, :pirates []}
-                                 {:index 37, :icon :ship, :pirates []}],
-                         :players [{:name "tanya", :color :orange, :cards [:hat :skull :knife :gun :bottle :key :gun]}
-                                   {:name "rusty", :color :black, :cards [:hat :gun :knife :gun :bottle :skull]}],
-                         :player-order ["tanya" "rusty"],
-                         :current-player "tanya",
-                         :actions-remaining 3,
-                         :draw-pile [:key
-                                     :bottle
-                                     :gun
-                                     :knife
-                                     :skull
-                                     :skull
-                                     :bottle
-                                     :key
-                                     :gun
-                                     :skull
-                                     :gun
-                                     :key
-                                     :skull
-                                     :key
-                                     :bottle
-                                     :skull
-                                     :key
-                                     :bottle
-                                     :bottle
-                                     :knife
-                                     :hat
-                                     :knife
-                                     :knife
-                                     :knife
-                                     :skull
-                                     :hat
-                                     :skull
-                                     :skull
-                                     :bottle
-                                     :key
-                                     :gun
-                                     :hat
-                                     :hat
-                                     :gun
-                                     :gun
-                                     :bottle
-                                     :key
-                                     :hat
-                                     :hat
-                                     :knife
-                                     :skull
-                                     :gun
-                                     :key
-                                     :skull
-                                     :hat
-                                     :bottle
-                                     :bottle
-                                     :skull
-                                     :gun
-                                     :hat
-                                     :knife
-                                     :key
-                                     :knife
-                                     :knife
-                                     :gun
-                                     :skull
-                                     :key
-                                     :hat
-                                     :hat
-                                     :bottle
-                                     :key
-                                     :knife
-                                     :knife
-                                     :skull
-                                     :key
-                                     :gun
-                                     :knife
-                                     :key
-                                     :bottle
-                                     :gun
-                                     :bottle
-                                     :skull
-                                     :hat
-                                     :key
-                                     :gun
-                                     :knife
-                                     :hat
-                                     :knife
-                                     :hat
-                                     :knife
-                                     :bottle
-                                     :key
-                                     :hat
-                                     :gun
-                                     :bottle
-                                     :hat
-                                     :gun
-                                     :key
-                                     :bottle
-                                     :skull],
-                         :discard-pile []}
-  )

 (defonce app-state (atom nil))

@@ -269,12 +131,27 @@
               :handler on-update-active-player
               :error on-error}))

+;; TODO: figure out a way to make this work elegantly with callbacks
+;; swiped from server code
+(defn game-over?
+  "Returns truthy if a player has 6 pirates on the ship; otherwise nil."
+  [board]
+  (let [ship (first (filter #(= :ship (:icon %)) board))
+        pirate-counts-by-color (frequencies (:pirates ship))]
+    (some #(>= (second %) 6) pirate-counts-by-color)))
+
+(defn end-game! []
+  (reset! app-state (assoc @app-state :game-over true)))
+
 (defn on-play-card [response]
-  (reset! app-state (assoc @app-state :board (:board response)
-                                      :discard-pile (:discard-pile response)
-                                      :players (conj (remove #{(active-player @app-state)} (:players @app-state)) (:player response))))
-  (reset! app-state (dissoc @app-state :selected-card))
-  (update-active-player! @app-state))
+  (let [board (:board response)]
+    (reset! app-state (assoc @app-state :board (:board response)
+                                        :discard-pile (:discard-pile response)
+                                        :players (conj (remove #{(active-player @app-state)} (:players @app-state)) (:player response))))
+    (reset! app-state (dissoc @app-state :selected-card))
+    (if (game-over? board)
+      (end-game!)
+      (update-active-player! @app-state))))

 (defn play-card! [player card from-space board discard-pile]
   (ajax/POST "http://localhost:3000/play-card"
@@ -412,7 +289,12 @@
       :on-click (fn button-click [e]
                   (new-game!))}
      "New Game"]]
+   (when (and @app-state (:game-over @app-state))
+     [:div
+      [:h2 "WE HAVE A WINNER!"]
+      [:h3 (str "Congratulations, " (:name (active-player @app-state)) "!")]])
    [:div
+    {:style {:float "left" :margin-left 10 :margin-right 10}}
     (-> [:svg
          {:view-box (str "0 0 " (to-scale 501) " " (to-scale 301))
           :width (to-scale 501)
@@ -425,7 +307,7 @@
    (when-let [active-player (active-player @app-state)]
      (let [{:keys [color cards] player-name :name} active-player
            card-groups (frequencies cards)]
-       [:div
+       [:div {:style {:margin-right 10}}
         [:table
          {:class "t1"}
          [:tbody


adding player instructions

adding player instructions

--- cartagena-web/src/cartagena_web/main.cljs
+++ cartagena-web/src/cartagena_web/main.cljs
@@ -384,56 +384,60 @@
    (when-let [active-player (active-player @app-state)]
      (let [{:keys [color cards] player-name :name} active-player
            card-groups (frequencies cards)]
-       [:div {:style {:margin-right 10}}
-        [:table
-         {:class "t1"}
-         [:tbody
+       [:div
+        [:div {:style {:margin-right 10}}
+         [:table
+          {:class "t1"}
+          [:tbody
+           [:tr
+            [:td "Current Player"]
+            [:td player-name]]]
           [:tr
-           [:td "Current Player"]
-           [:td player-name]]]
-         [:tr
-          [:td "Color"]
-          [:td
-           [:svg
-            {:width (to-scale 20)
-             :height (to-scale 20)}
-            [:circle
-             {:cx (to-scale 10)
-              :cy (to-scale 10)
-              :r (to-scale 7)
-              :fill (name color)}]]
-           [:span {:style {:color (name color)}} (name color)]]]
-         [:tr
-          [:td "Actions Remaining"]
-          [:td (:actions-remaining @app-state)]]
-         [:tr
-          [:td "Cards"]
-          [:td (for [[card num] card-groups]
-                 ^{:key card}
-                 [:span {:style {:float "left"}}
-                  [:figure
+           [:td "Color"]
+           [:td
+            [:svg
+             {:width (to-scale 20)
+              :height (to-scale 20)}
+             [:circle
+              {:cx (to-scale 10)
+               :cy (to-scale 10)
+               :r (to-scale 7)
+               :fill (name color)}]]
+            [:span {:style {:color (name color)}} (name color)]]]
+          [:tr
+           [:td "Actions Remaining"]
+           [:td (:actions-remaining @app-state)]]
+          [:tr
+           [:td "Cards"]
+           [:td (for [[card num] card-groups]
+                  ^{:key card}
+                  [:span {:style {:float "left"}}
+                   [:figure
+                    [:img
+                     {:src (card icon-images)
+                      :width (to-scale 30)
+                      :height (to-scale 30)
+                      :on-click (fn img-click [e]
+                                  (select-card! card))}]
+                    [:center [:figcaption num]]]])]]
+          [:tr
+           [:td "Selected Card"]
+           [:td [:span {:style {:float "left"}}
+                 (when-let [selected-card (:selected-card @app-state)]
                    [:img
-                    {:src (card icon-images)
+                    {:src (selected-card icon-images)
                      :width (to-scale 30)
                      :height (to-scale 30)
                      :on-click (fn img-click [e]
-                                 (select-card! card))}]
-                   [:center [:figcaption num]]]])]]
-         [:tr
-          [:td "Selected Card"]
-          [:td [:span {:style {:float "left"}}
-                (when-let [selected-card (:selected-card @app-state)]
-                  [:img
-                   {:src (selected-card icon-images)
-                    :width (to-scale 30)
-                    :height (to-scale 30)
-                    :on-click (fn img-click [e]
-                                (unselect-card!))}])]]]
-         [:tr
-          [:td {:colSpan 2}
-           [:center
-            [:button {:on-click (fn btn-click [e]
-                                  (update-active-player! @app-state))} "Pass"]]]]]]))])
+                                 (unselect-card!))}])]]]
+          [:tr
+           [:td {:colSpan 2}
+            [:center
+             [:button {:on-click (fn btn-click [e]
+                                   (update-active-player! @app-state))} "Pass"]]]]]]
+        [:div
+         [:p "To move forward, click a card, then click the target pirate.  To undo card selection, click the selected card."]
+         [:p "To move backward, click the target pirate."]]]))])

 (defn ^:export main []
   (when-let [app (. js/document (getElementById "app"))]


Add behavior to the `view` button on workspace.

--- src/uxbox/main/ui/workspace/header.cljs
+++ src/uxbox/main/ui/workspace/header.cljs
@@ -9,6 +9,7 @@
   (:require [sablono.core :as html :refer-macros [html]]
             [rum.core :as rum]
             [beicon.core :as rx]
+            [uxbox.config :as cfg]
             [uxbox.util.router :as r]
             [uxbox.util.rstore :as rs]
             [uxbox.main.data.workspace :as dw]
@@ -68,16 +69,21 @@
         url (.createObjectURL (.-URL js/window) data)]
     (set! (.-href (.-currentTarget event)) url)))

+(defn on-view-clicked
+  [event project page]
+  (let [url (str cfg/viewurl "#/" (:share-token project))]
+    (js/open url "new tab" "")
+    #_(set! (.-href js/location) url)))
+
 (defn header-render
   [own]
-  (let [page (mx/react wb/page-ref)
+  (let [project (mx/react wb/project-ref)
+        page (mx/react wb/page-ref)
         flags (mx/react wb/flags-ref)
         toggle #(rs/emit! (dw/toggle-flag %))
         on-undo #(rs/emit! (udh/backwards-to-previous-version))
         on-redo #(rs/emit! (udh/forward-to-next-version))
-        on-image #(udl/open! :new-image)
-        ;; TODO: temporary
-        open-confirm-dialog #(udl/open! :confirm)]
+        on-image #(udl/open! :new-image)]
     (html
      [:header#workspace-bar.workspace-bar
       [:div.main-icon
@@ -155,7 +161,8 @@
          i/alignment]]
        [:ul.options-btn
         [:li.tooltip.tooltip-bottom
-         {:alt "View mode (Ctrl + P)"}
+         {:alt "View mode (Ctrl + P)"
+          :on-click #(on-view-clicked % project page)}
          i/play]]
        (coordinates)]
       (ui.u/user)])))
@@ -164,4 +171,4 @@
   (mx/component
    {:render header-render
     :name "workspace-header"
-    :mixins [mx/reactive]}))
+    :mixins [mx/static mx/reactive]}))


can run from command line as well

can run from command line as well

--- src/crawler/main.clj
+++ src/crawler/main.clj
@@ -24,7 +24,8 @@
     :parse-fn #(Integer/parseInt %)]
    [nil "--refine" "Refine a model file"]
    [nil "--corpus CORPUS" "Specify a corpus"]
-   [nil "--corpus-to-json CORPUS" "Convert corpus file to json file"]])
+   [nil "--corpus-to-json CORPUS" "Convert corpus file to json file"]
+   [nil "--fix-model D" "Fix a model with pagination info"]])

 (defn dump-state-model-corpus
   "Creates a dated file _prefix_-yr-month-day-hr-min.corpus/state/model"
@@ -118,13 +119,27 @@
                                    model
                                    num-leaves))

-          (:refine options)
-          (let [model-file (:model options)
-                corpus     (:corpus options)]
-            (crawler-model/plan-dump-model model-file corpus))
-
           (:corpus-to-json options)
           (corpus/corpus->json (:corpus-to-json options))
+
+          (:fix-model options)
+          (let [directory (:fix-model options)
+                model-file (.getAbsolutePath
+                            (first
+                             (filter
+                              #(re-find #"\.model$" (.getAbsolutePath %))
+                              (file-seq (io/file directory)))))
+                corpus-file (.getAbsolutePath
+                             (first
+                              (filter
+                               #(re-find #"\.corpus$" (.getAbsolutePath %))
+                               (file-seq (io/file directory)))))
+
+                fixed-model
+                (crawler-model/fix-model model-file
+                                         corpus-file)]
+            (pprint fixed-model (io/writer (str (:fix-model options)
+                                                "pruned-model"))))

           :else
           (println "Pick one bruh"))))


Allow pipelined (non-throwing) Lua script exceptions

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -172,11 +172,11 @@
   (let [parser protocol/*parser*
         [r & _] (->> (apply evalsha* script numkeys key args)
                      (with-replies :as-pipeline))]
-    (if (instance? Exception r)
-      (if (.startsWith (.getMessage ^Exception r) "NOSCRIPT")
-        (with-parser parser (apply eval script numkeys key args))
-        (throw r))
-      (with-parser parser (return r)))))
+    (with-parser parser
+      (if (and (instance? Exception r)
+               (.startsWith (.getMessage ^Exception r) "NOSCRIPT"))
+        (apply eval script numkeys key args)
+        (return r)))))

 (def ^:private interpolate-script
   "Substitutes indexed KEYS[]s and ARGV[]s for named variables in Lua script.


Fix: :attrs options

Fix: :attrs options

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -363,7 +363,7 @@
       :always     (.setTableName       (name table))
       :always     (.setKey             (clj-item->db-item prim-kvs))
       consistent? (.setConsistentRead  g)
-      attrs       (.setAttributesToGet g)))))
+      attrs       (.setAttributesToGet (mapv name g))))))

 (defn- expected-values
   "{<attr> <cond> ...} -> {<attr> ExpectedAttributeValue ...}"
@@ -538,7 +538,7 @@
        limit         (.setLimit    (long g))
        index         (.setIndexName      g)
        consistent?   (.setConsistentRead g)
-       (coll? return)       (.setAttributesToGet    return)
+       (coll? return)       (.setAttributesToGet (mapv name return))
        (not (coll? return)) (.setSelect (utils/enum return))))))

 (defn scan
@@ -565,7 +565,7 @@
        limit          (.setLimit             (long g))
        total-segments (.setTotalSegments     (long g))
        segment        (.setSegment           (long g))
-       (coll? return)       (.setAttributesToGet    return)
+       (coll? return)       (.setAttributesToGet (mapv name return))
        (not (coll? return)) (.setSelect (utils/enum return))))))

 (defn scan-parallel


azulenoids.clj: simplified some more

azulenoids.clj: simplified some more

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -6,7 +6,7 @@
   (:gen-class))

 (defn iterate-cycle [coll x]
-  (reductions (fn [x f] (f x)) x (cycle coll)))
+  (reductions #(%2 %1) x (cycle coll)))

 (defn lazy-mapcat [f & colls]
   (lazy-seq
@@ -15,7 +15,7 @@
              (apply lazy-mapcat f (map rest colls))))))

 (defn walk [ds D & idxs]
-  (reduce (fn [D i] (.op ds i D)) D idxs))
+  (reduce #(.op ds %2 %1) D idxs))

 (defn chain-end [ds D i j]
   (letfn [(step [E]
@@ -28,16 +28,14 @@
     (step (walk ds D i))))

 (defn boundary-chambers [ds D i j k]
-  (letfn [(a [D] (walk ds D i))
-          (b [D] (chain-end ds D j k))]
-    (iterate-cycle [a b] D)))
+  (iterate-cycle [#(walk ds %1 i) #(chain-end ds %1 j k)] D))

 (defn max-curvature [ds]
   (let [dsx (.clone ds)]
     (do (.setVDefaultToOne dsx true) (.curvature2D dsx))))

 (defn syms-for [ds]
-  (filter (fn [ds] (-> ds .curvature2D .isZero))
+  (filter #(-> %1 .curvature2D .isZero)
           (lazy-seq (new DefineBranching2d ds 3 2 Whole/ZERO))))

 (def template
@@ -54,12 +52,10 @@
   (new DSymbol "1.1:16 1:2 4 6 8 10 12 14 16,16 3 5 7 9 11 13 15:8"))

 (def boundary-mappings
-  (let [offset (fn [p] (mod (- 19 p) 16))
-        box (fn [i] (Integer. i))
-        template-boundary (boundary-chambers template (box 1) 0 1 2)
-        octagon-boundary (cycle (map box (range 1 17)))
-        mapping (fn [p] (zipmap (drop (offset p) octagon-boundary)
-                                (take 16 template-boundary)))]
+  (let [template-boundary (boundary-chambers template (Integer. 1) 0 1 2)
+        octagon-boundary (cycle (map #(Integer. %1) (range 1 17)))
+        mapping #(zipmap (drop (mod (- 19 %1) 16) octagon-boundary)
+                         (take 16 template-boundary))]
     (map mapping (range 1 16 2))))

 (defn apply-to-template [ds oct2tmp]


Fixed an other bug related to auth data management.

--- src/uxbox/data/load.cljs
+++ src/uxbox/data/load.cljs
@@ -37,11 +37,11 @@
         projects (into #{} (vals (:projects-by-id state)))
         shapes (into #{} (vals (:shapes-by-id state)))
         color-colls (into #{} (vals (:colors-by-id state)))]
-    (assoc! local-storage :data {:pages pages
-                                 :auth (:auth state)
-                                 :shapes shapes
-                                 :projects projects
-                                 :color-collections color-colls})))
+    (assoc! local-storage ::auth (:auth state))
+    (assoc! local-storage ::data {:pages pages
+                                  :shapes shapes
+                                  :projects projects
+                                  :color-collections color-colls})))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Events
@@ -53,12 +53,14 @@
   (reify
     rs/UpdateEvent
     (-apply-update [_ state]
-      (if-let [data (get local-storage :data nil)]
-        (as-> state $
-          (reduce stpr/assoc-project $ (:projects data))
-          (reduce stpr/assoc-page $ (:pages data))
-          (reduce assoc-color $ (:color-collections data))
-          (reduce assoc-shape $ (:shapes data))
-          (assoc $ :auth (:auth data)))
-        state))))
+      (let [auth (::auth local-storage)
+            data (::data local-storage)
+            state (assoc state :auth auth)]
+        (if data
+          (as-> state $
+            (reduce stpr/assoc-project $ (:projects data))
+            (reduce stpr/assoc-page $ (:pages data))
+            (reduce assoc-color $ (:color-collections data))
+            (reduce assoc-shape $ (:shapes data)))
+          state)))))


CMR-366: Added sorting tests for granule ur, producer granule id, and readable granule name.

--- test/cmr/system_int_test/search/granule_sorting_search_test.clj
+++ test/cmr/system_int_test/search/granule_sorting_search_test.clj
@@ -17,6 +17,31 @@
   (is (= {:status 422
           :errors [(msg/invalid-sort-key "foo" :granule)]}
          (search/find-refs :granule {:sort-key "foo"}))))
+
+(deftest granule-identifier-sorting-test
+  (let [coll (d/ingest "PROV1" (dc/collection {}))
+        make-gran (fn [granule-ur producer-gran-id]
+                    (d/ingest "PROV1" (dg/granule coll {:granule-ur granule-ur
+                                                        :producer-gran-id producer-gran-id})))
+        g1 (make-gran "gur10" nil)
+        g2 (make-gran "gur20" "pg50")
+        g3 (make-gran "gur30" "pg40")
+        g4 (make-gran "gur40" "pg30")
+        g5 (make-gran "gur50" nil)]
+    (index/flush-elastic-index)
+    (are [sort-key items]
+         (d/refs-match-order? items
+                              (search/find-refs :granule {:page-size 20
+                                                          :sort-key sort-key}))
+         "granule_ur" [g1 g2 g3 g4 g5]
+         "-granule_ur" (reverse [g1 g2 g3 g4 g5])
+
+         "producer_granule_id" [g4 g3 g2 g1 g5]
+         "-producer_granule_id" [g2 g3 g4 g1 g5]
+
+         "readable_granule_name" [g1 g5 g4 g3 g2]
+         "-readable_granule_name" (reverse [g1 g5 g4 g3 g2]))))
+

 (deftest coll-identifier-sorting-test
   (let [make-gran (fn [provider entry-title short-name version]


provide environment variables for host, port, nick, channel

--- src/goodbot/core.clj
+++ src/goodbot/core.clj
@@ -5,11 +5,17 @@
             [goodbot.plugins.ping :as ping]
             [goodbot.plugins.clojure :as clj]))

+(def host    (or (System/getenv "GOODBOT_HOST")    "irc.freenode.net"))
+(def port    (or (System/getenv "GOODBOT_PORT")    6667))
+(def nick    (or (System/getenv "GOODBOT_NICK")    "goodbot-test"))
+(def channel (or (System/getenv "GOODBOT_CHANNEL") "#goodbot-test"))
+
 (defn -main
   "Starts the bot"
   [& args]
-  (let [bot (irclj/connect "irc.freenode.net" 6667 "goodbot-test"
+  (println (str "connecting to " host ":" port channel " as " nick))
+  (let [bot (irclj/connect host port nick
                            :callbacks {:privmsg (bot/make-callback
                                                   [ping/plugin
                                                    clj/plugin])})]
-    (irclj/join bot "#csuatest")))
+    (irclj/join bot channel)))


Missing parens

Missing parens

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -241,7 +241,7 @@
            [part parts] parts]
       (if-not parent
         (let [typef (io/file )])
-))
+        ))))

 (defn thing->relative-path [class thing]
   (->> thing


Remove fn tagged for deletion

Remove fn tagged for deletion

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -61,18 +61,6 @@
   specified Platform does not exist or if another Failure is encountered."

   {:arglists '[[config platform-thing]]}
-  dispatch)
-
-(defmulti list-classes
-  "Succeeds with a result Seq[Class] representing all Java classes in the
-  specified Version. Could succeed with an empty result. Fails if the specified
-  Version does not exist or of another failure is encountered.
-
-  Deprecated as of 0.7.0
-  Will be removed in 0.8.0"
-
-  {:arglists   '[[config version-thing]]
-   :deprecated "0.7.0"}
   dispatch)

 (defmulti list-defs


Flag cheshire for removal

Flag cheshire for removal

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -10,7 +10,7 @@
             [clojure.java.io :as io]
             [clojure.string :as string]
             [clojure.edn :as edn]
-            [cheshire.core :as json]
+            [cheshire.core :as json]    ; FIXME: remove? in project.clj?
             [clj-semver.core :as semver]))

 ;; Interacting with the datastore - reading


Work on fixing ::T/a bug

Work on fixing ::T/a bug

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -58,17 +58,19 @@
   (when-let [filepath (:file (meta v))]
     (when-let [strm (.getResourceAsStream (clojure.lang.RT/baseLoader) filepath)]
       (with-open [rdr (java.io.LineNumberReader. (java.io.InputStreamReader. strm))]
-        (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
+        (dotimes [_ (dec (:line (meta v)))]
+          (.readLine rdr))
         (let [text (StringBuilder.)
-              pbr (proxy [java.io.PushbackReader] [rdr]
-                    (read [] (let [i (proxy-super read)]
-                               (.append text (char i))
-                               i)))]
+              pbr  (proxy [java.io.PushbackReader] [rdr]
+                     (read [] (let [i (proxy-super read)]
+                                (.append text (char i))
+                                i)))]
           (if (= :unknown *read-eval*)
             (throw
              (IllegalStateException.
               "Unable to read source while *read-eval* is :unknown."))
-            (read (java.io.PushbackReader. pbr)))
+            (binding [*ns* (the-ns (var->ns v))]
+              (read (java.io.PushbackReader. pbr))))
           (str text))))))

 (defn ns-stringifier


CMR-1344: Fix typos

CMR-1344: Fix typos

--- dev-system/src/cmr/dev_system/control.clj
+++ dev-system/src/cmr/dev_system/control.clj
@@ -169,13 +169,13 @@
            :body "Cannot turn message queue fallback on unless using the message queue."}))

       (POST "/turn-off-http-fallback" []
-        (debug "Turning on http fallback for message queue")
+        (debug "Turning off http fallback for message queue")
         (if (iconfig/use-index-queue?)
           (do
             (iconfig/set-indexing-communication-method! "queue")
             {:status 200})
           {:status 403
-           :body "Cannot turn message queue fallback on unless using the message queue."}))
+           :body "Cannot turn message queue fallback off unless using the message queue."}))

       ;; Used to change the timeout used for queueing messages on the message queue. For tests which
       ;; simulate a timeout error, set the timeout value to 0.


Debug

Debug

--- backend/src/akvo/lumen/lib/dashboard.clj
+++ backend/src/akvo/lumen/lib/dashboard.clj
@@ -95,10 +95,13 @@
     (let [dashboard (handle-dashboard-by-id tenant-conn id)
           aggregated-dashboard (aggregation/aggregate-dashboard-viss dashboard tenant-conn windshaft-url)
           aggregated-entities (reduce (fn [c [k v]] (assoc c k (assoc v :type "visualisation")))
-                                      {} (:visualisations aggregated-dashboard))]
+                                      {} (:visualisations aggregated-dashboard))
+          res (update dashboard :entities #(merge % aggregated-entities))]
       (log/info :fetch-aggregated :aggregated-dashboard aggregated-dashboard)
       (log/info :fetch-aggregated :aggregated-entities aggregated-entities)
-      (update dashboard :entities #(merge % aggregated-entities)))))
+      (log/info :fetch-aggregated :dashboard dashboard)
+      (log/info :fetch-aggregated :res res)
+      res)))

 (defn upsert
   "We update a dashboard via upsert of dashboard and clean - insert of


Revert "Handle a transient problem during database migrations where it may attempt to start the oracle store twice."

This reverts commit 5950e962fc865012ed7344a1ac581b2e1206f62e.

--- oracle-lib/src/cmr/oracle/connection.clj
+++ oracle-lib/src/cmr/oracle/connection.clj
@@ -114,16 +114,6 @@
       (.setValidateConnectionOnBorrow true)
       (.setSQLForValidateConnection "select 1 from DUAL"))))

-(defn cleanup-connection-pool
-  [oracle-store]
-  (try
-    (let [pool-name (get-in oracle-store [:spec :connection-pool-name])
-          ucp-manager (UniversalConnectionPoolManagerImpl/getUniversalConnectionPoolManager)]
-      (.destroyConnectionPool ucp-manager pool-name))
-    (catch Exception e
-      (warn (str "Unable to destroy connection pool. It may not have started. Error: "
-                 (.getMessage e))))))
-
 (defrecord OracleStore
   [
    ;; The database spec.
@@ -139,21 +129,20 @@

   (start [this system]
          (let [this (assoc this :datasource (pool spec))]
-           (try
-             (test-db-connection! this)
-             (catch Exception e
-               ;; Handle the case during use of repl or database migrations where the connection pool
-               ;; may have already been created. If so we'll cleanup the connection pool and then
-               ;; try it again.
-               (if (.contains (.getMessage e) "Universal Connection Pool already exists in the Universal Connection Pool Manager.")
-                 (do
-                   (cleanup-connection-pool this)
-                   (test-db-connection! this))
-                 (throw e))))
+           (test-db-connection! this)
            this))

   (stop [this system]
-        (cleanup-connection-pool this)
+
+        (try
+          ;; Cleanup the connection pool
+          (let [pool-name (get-in this [:spec :connection-pool-name])
+                ucp-manager (UniversalConnectionPoolManagerImpl/getUniversalConnectionPoolManager)]
+            (.destroyConnectionPool ucp-manager pool-name))
+          (catch Exception e
+            (warn (str "Unable to destroy connection pool. It may not have started. Error: "
+                       (.getMessage e)))))
+
         (dissoc this :datasource)))


simplify3d.clj: further work toward recognizing local 2 cuts

--- clojure/org/gavrog/clojure/simplify3d.clj
+++ clojure/org/gavrog/clojure/simplify3d.clj
@@ -62,10 +62,16 @@
           :when (pos? (count common))]
       [f g common])))

+(defn- positions [p xs]
+  (for [[i x] (zipmap (range) xs) :when (p x)] i))
+
 (defn- local-2-cuts [ds]
   (filter (fn [[f g common]]
             (let [verts (map (fn [D] (set (orbit-elements ds [1 2] D))) common)
-                  _ (println verts)]
+                  find (fn [D] (first (positions #(% D) verts)))
+                  pf (map find f)
+                  pg (map find g)
+                  _ (println pf pg)]
             ))
           (face-intersections ds)))


planning

planning

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -139,6 +139,20 @@
         ref:
           http://www.html5rocks.com/en/tutorials/audio/scheduling
           https://github.com/cwilso/metronome/blob/master/js/metronome.js
+
+        - cljs lacks a good 'reliable clock' library -- this would be a good
+          opportunity to create one, and use it for mantra. The article
+          above explains what appears to be a really good system, based on a
+          collaboration between the Web Audio clock and the JS clock
+          (e.g setTimeout). The cool thing is that the Web Audio clock exists
+          whether or not you are using the Web Audio API, so you can easily
+          use it to schedule arbitrary events, audio-related or not.
+
+          There is already a JS library that does what I'm describing:
+          https://github.com/sebpiq/WAAClock
+
+          Basically we want a cljs port of that.
+
     - play-notes and play-chord will also stop all notes
     - there should also be an also-play-note, which does the same thing as play-note, but doesn't stop any currently playing nodes
     - ditto for also-play-chord, also-play-notes


Updated comment.

Updated comment.

--- common-lib/src/cmr/common/util.clj
+++ common-lib/src/cmr/common/util.clj
@@ -257,13 +257,13 @@
        (every? matches-fn)))

 (defn greater-than?
-  "Returns true if the given values are in ascending order. This is similar to core/> except it uses
+  "Returns true if the given values are in descending order. This is similar to core/> except it uses
   compare function underneath and applies to other types other than just java.lang.Number."
   [& values]
   (compare-results-match? pos? values))

 (defn less-than?
-  "Returns true if the given values are in descending order. This is similar to core/< except it uses
+  "Returns true if the given values are in ascending order. This is similar to core/< except it uses
   compare function underneath and applies to other types other than just java.lang.Number."
   [& values]
   (compare-results-match? neg? values))


Logs job instance when preemption transaction fails (#2001)

* Logs job instance when preemption transaction fails

* Extracts function for preeemption transaction

--- scheduler/src/cook/rebalancer.clj
+++ scheduler/src/cook/rebalancer.clj
@@ -470,7 +470,28 @@
         (select-keys [:db/id :instance/task-id])
         (assoc :job (prep-job-ent-for-printing job-ent)))))

-
+(defn transact-preemption!
+  "Transacts the rebalancer preemption for the given task-ent"
+  [db conn pool-name task-ent]
+  (try
+    @(d/transact
+       conn
+       ;; Make :instance/status and :instance/preempted? consistent to simplify the state machine.
+       ;; We don't want to deal with {:instance/status :instance.status/running, :instance/preempted? true}
+       ;; all over the place.
+       (let [job-eid (:db/id (:job/_instance task-ent))
+             task-eid (:db/id task-ent)]
+         [[:generic/ensure task-eid :instance/status (d/entid db :instance.status/running)]
+          [:generic/atomic-inc job-eid :job/preemptions 1]
+          ;; The database can become inconsistent if we make multiple calls to :instance/update-state in a single
+          ;; transaction; see the comment in the definition of :instance/update-state for more details
+          [:instance/update-state task-eid :instance.status/failed [:reason/name :preempted-by-rebalancer]]
+          [:db/add task-eid :instance/reason [:reason/name :preempted-by-rebalancer]]
+          [:db/add task-eid :instance/preempted? true]]))
+    (catch Throwable e
+      (log/warn
+        e "In" pool-name "pool, failed to transact preemption"
+        {:to-preempt (prep-task-ent-for-printing task-ent)}))))

 (defn rebalance!
   [db conn agent-attributes-cache rebalancer-reservation-atom params init-state jobs-to-make-room-for pool-name]
@@ -497,23 +518,7 @@
         ;;        however it is here now to allow us to audit how frequently a synthetic
         ;;        task is "preempted"
         (doseq [task-ent (filter :db/id task-ents-to-preempt)]
-          (try
-            @(d/transact
-               conn
-               ;; Make :instance/status and :instance/preempted? consistent to simplify the state machine.
-               ;; We don't want to deal with {:instance/status :instance.status/running, :instance/preempted? true}
-               ;; all over the place.
-               (let [job-eid (:db/id (:job/_instance task-ent))
-                     task-eid (:db/id task-ent)]
-                 [[:generic/ensure task-eid :instance/status (d/entid db :instance.status/running)]
-                  [:generic/atomic-inc job-eid :job/preemptions 1]
-                  ;; The database can become inconsistent if we make multiple calls to :instance/update-state in a single
-                  ;; transaction; see the comment in the definition of :instance/update-state for more details
-                  [:instance/update-state task-eid :instance.status/failed [:reason/name :preempted-by-rebalancer]]
-                  [:db/add task-eid :instance/reason [:reason/name :preempted-by-rebalancer]]
-                  [:db/add task-eid :instance/preempted? true]]))
-            (catch Throwable e
-              (log/warn e "Failed to transact preemption")))
+          (transact-preemption! db conn pool-name task-ent)
           (when-let [task-id (:instance/task-id task-ent)]
             (when-let [compute-cluster (task/task-ent->ComputeCluster task-ent)]
               (cc/safe-kill-task compute-cluster task-id))))))))


code to stop application event loop

code to stop application event loop

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -118,10 +118,15 @@
         subscriber (.get (.call memory "subscriber" (into-array [event])))]
     (.connect subscriber "signal::(m)" "invoke::m(m)" callback)))

-(defn start-main-loop
-  "Starts the Qimessaging event loop"
+(defn start-event-loop
+  "Starts the Qimessaging Application event loop - there can only be one of these running"
   [robot]
   (.start (Thread. (fn [] (.run (:application robot))))))
+
+(defn stop-event-loop
+  "Stops the Qimessaging application event loop"
+  [robot]
+  (.stop (:application robot)))

 ; behaviour management
 (defn get-installed-behaviours