reverting wrong commit

reverting wrong commit

--- src/iyye/bios/core.clj
+++ src/iyye/bios/core.clj
@@ -14,111 +14,111 @@
 ; You should have received a copy of the GNU Affero General Public License
 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.

-(ns iyye.subcon.knowledge.words
-  (:require
-    [clojure.tools.logging :as log]
-    [iyye.bios.ioframes :as ioframes]
-    [iyye.bios.persistence :as persistence]
-    ;[iyye.subcon.knowledge.relation :as relation]
-    ))
+(ns iyye.bios.core
+  (:require [iyye.bios.iolist :as iolist]
+            [iyye.bios.resource :as resource]
+            [iyye.bios.persistence :as persistence]
+            [iyye.bios.noun-words :as nouns]
+            [iyye.bios.task :as task]
+            [iyye.subcon.knowledge.words :as kb]
+            [clojure.tools.logging :as log]
+            [clojure.tools.cli :refer [parse-opts]]
+            [clojure.string :as str]
+            ))

-(def relations-words (ref []))
-(def types-words (ref []))
-(def instances-words (ref []))
-(def adjective-words (ref []))
-(def action-words (ref []))
+(def DAY_CHECK_TIME_MILLIS 1000)

-(defrecord Iyye_Predicate [AccordingTo When Time Prob])
+; wake sleep state machine
+(defn main-loop []
+    (let [current-day (resource/create-day)]
+      (resource/start-day current-day)

-(defrecord Iyye_Atom [Name Uname predicate])
+      (while (not (resource/is-day-over? current-day))
+        (Thread/sleep DAY_CHECK_TIME_MILLIS))

-(defn create-iyye-atom [name according when words-list]
-  (let [Time (persistence/current-time-to-string)
-        uname (str name (count words-list))
-        atom (->Iyye_Atom name uname (->Iyye_Predicate according when Time 1.0))]
-    atom))
+      (resource/stop-day current-day)

-(defrecord Iyye_Type [atom SubtypeOf Subtypes Predicates])
+      (let [current-night (resource/create-night current-day)]
+        (resource/start-night current-night)
+        (while (not (resource/is-night-over? current-night))
+          (Thread/sleep DAY_CHECK_TIME_MILLIS))

-(defn create-iyye-type [Name AccordingTo When SubtypeOf Subtypes]
-  (let [type-atom (create-iyye-atom Name AccordingTo When types-words)
-        type (->Iyye_Type type-atom SubtypeOf Subtypes [])]
-    type))
+        (resource/stop-night current-night))))

-(defn load-iyye-atom-from-db [uname]
-  )
+(def main-task {:name "iyye.bios.main" :function main-loop :task-future (ref 0) :parent nil})

-(defn load-iyye-type-from-db [name]
-  )
+(defn- load-state [name]
+  (log/info "first day load")
+  (persistence/load-current-iyye name)
+  (nouns/add-word "iyye.name" #(list name) nil)
+  (resource/load-day!)
+  (iolist/load-io-state)
+  (kb/load-init-kb))

-;(dosync (alter types-words conj type))
-;(persistence/write-noun-to-db (into {} type))
+(defn- init-state [name]
+  (log/info "first day")
+  (nouns/add-word "iyye.name" #(list name) nil)
+  (persistence/set-current-iyye name)
+  (kb/init-kb))

-(defrecord Iyye_Relation [atom Reason Types Function])
+(defn usage [options-summary]
+  (->> ["Usage: iyye action/option"
+        ""
+        "Options:"
+        options-summary
+        ""
+        "Actions:"
+        "  list    list IYYE"
+        "  load     load IYYE"
+        "  create   create IYYE"
+        ""]
+       (str/join \newline)))

-(defn create-iyye-relation [Name AccordingTo Reason When Types Function]
-  (let [action-atom (create-iyye-atom Name AccordingTo When @relations-words)
-        relation (->Iyye_Relation action-atom Reason Types Function)]
-    relation))
+(def cli-options
+  ;; An option with a required argument
+  [["-n" "--name IYYE" "IYYE name"
+    :default "new"]
+   ;   :validate [#(iyye-exists? %) "Does not exist"]]
+   ["-h" "--help"]])

-(defrecord Iyye_Instance [atom type])
+(defn error-msg [errors]
+  (str "The following errors occurred while parsing your command:\n\n"
+       (str/join \newline errors)))

-(defn create-iyye-instance [values])
+(defn validate-args
+  "Validate command line arguments. Either return a map indicating the program
+  should exit (with a error message, and optional ok status), or a map
+  indicating the action the program should take and the options provided."
+  [args]
+  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
+    ;       (println "opt:" options "args:" arguments "err:" errors "summary:" summary)
+    (cond
+      (:help options) ; help => exit OK with usage summary
+      {:exit-message (usage summary) :ok? true}

-;(dosync (alter relations-words conj relation))
-;(persistence/write-action-to-db (conj (into {} (:atom 8action)) (dissoc (into {} action) :atom)))
-;
-; (defn write-to-db [atom]
-;  (persistence/write-knowledge-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom))))
+      errors ; errors => exit with description of errors
+      {:exit-message (error-msg errors)}

-;(defn ^{:source "(+ 1 a)"} aaa [a] (+ 1 a))
-;(defmacro getsrc [func] `(:source (meta (var ~func))))
+      (and (= 1 (count arguments))
+           (#{"create" "list" "load"} (first arguments)))
+      {:action (first arguments) :options options}
+      :else ; failed custom validation => exit with usage summary
+      {:exit-message (usage summary)})))

-(defn iyye_is_type_function [p1 p2]
-  (let [p2-type (load-iyye-type-from-db p2)
-        newtype (if p2-type p2-type (create-iyye-type p2 :IYE :ALWAYS p1 []))])
+(defn exit [status msg]
+  (println msg)
+  (System/exit status))

-  )
+(defn -main [& args]
+  (let [{:keys [action options exit-message ok?]} (validate-args args)]
+    (if exit-message
+      (exit (if ok? 0 1) exit-message)
+      (case action
+        "list"   (doall (println (persistence/list-iyye) ) (exit 0 ""))
+        "create" (if (persistence/iyye-exists? (:name options)) (exit -1 "Already exists") (init-state (:name options)))
+        "load"  (if (persistence/iyye-exists? (:name options)) (load-state (:name options)) (exit -1 "Does not exist")))))

-(defn iyye_consists_function [p1 p2]
-  (let [])
-  )
-
-(def iyye_is_type (ref 0))
-(def iyye_consists_type (ref 0))
-
-(defn action [cmd params IO]
-  (let [actions
-        (for [action @action-words :when (= (:Name action) cmd)]
-          action)]
-    (case (count actions)
-      0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
-      1 (let [action (first actions)]
-          (if (compare params (:Types action))
-            ((:Function action) params)
-            (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))
-      (ioframes/process-output IO (str "failed to parse: too many matched action to " cmd ": " actions)))))
-
-(defn- init-builtins-kb []
-  (let [is (create-iyye-relation "is" :IYE :AXIOM :ALWAYS [] iyye_is_type_function)
-        consistsof (create-iyye-relation "consists" :IYE :AXIOM :ALWAYS [] iyye_consists_function)]
-    (dosync (ref-set iyye_is_type is))
-    (dosync (ref-set iyye_consists_type consistsof))
-    ))
-
-  (defn init-kb []
-    (init-builtins-kb)
-    ; (dosync (alter noun-words conj iyye_concept))
-
-    ;(dorun (map #(do ( persistence/write-fact-to-db (into {} %))) @action-words))
-    )
-
-(defn load-init-kb []
-  (init-builtins-kb)
-  (dosync (alter relations-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "relations" {:When :ALWAYS})))
-  (dosync (alter types-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "nouns" {:When :ALWAYS})))
-
-  )
-
-
-; (apply str (rest (str (:When {:When :ALWAYS}))))
+  (doall  (iolist/init-io))
+  (nouns/add-word "iyye.days" #(list @resource/num-days) nil)
+  ; Start in a thread so that I can use REPL too
+  (task/start-task main-task))


First attempt at running tests inside of pods

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -1,6 +1,7 @@
 (ns radicalzephyr.boot-junit
   {:boot/export-tasks true}
   (:require [boot.core :as core]
+            [boot.pod  :as pod]
             [clojure.string :as str]
             [clojure.pprint :refer [cl-format]]
             [clansi.core    :refer [style]])
@@ -15,7 +16,80 @@
                                  ConfigurationBuilder
                                  FilterBuilder)))

-(defn- build-package-config [^String package]
+(def pod-deps
+  '[[radicalzephyr/clansi "1.2.0" :exclusions [org.clojure/clojure]]])
+
+(defn init [fresh-pod]
+  (doto fresh-pod
+    (pod/with-eval-in
+      (require '[clojure.pprint :refer [cl-format]]
+               '[clojure.string :as str]
+               '[clansi.core    :refer [style]])
+      (import org.junit.runner.JUnitCore
+              org.junit.runner.notification.RunListener)
+      (defn- print-ignored-tests [ignored-tests]
+        (when (seq ignored-tests)
+          (println "Ignored:")
+          (println)
+          (doseq [[i ignored] (map-indexed vector ignored-tests)]
+            (printf "  %d) %s\n"
+                    (inc i) (style (.getDisplayName ignored) :yellow))
+            (println))))
+
+      (defn- print-failed-tests [test-failures]
+        (when (seq test-failures)
+          (println "Failed:")
+          (println)
+          (doseq [[i failure] (map-indexed vector test-failures)]
+            (printf "  %d) %s\n"
+                    (inc i) (.getTestHeader failure))
+            (printf "     %s\n" (style (.getTrace failure)
+                                       :red))
+            (println))))
+
+      (defn- print-test-summary [result]
+        (printf "Finished in %s seconds\n" (float (/ (.getRunTime result) 1000)))
+        (let [run-count     (.getRunCount      result)
+              ignore-count  (.getIgnoreCount   result)
+              failure-count (.getFailureCount  result)
+              test-count (+ run-count ignore-count)]
+          (println (style (cl-format nil "~D test~:P, ~D failure~:P~[~;, ~:*~D ignored~]~%"
+                                     test-count failure-count ignore-count)
+                          (if (> failure-count 0) :red :green)))))
+      (defn run-listener [packages]
+        (let [running-tests (atom #{})
+              ignored-tests (atom #{})]
+          (proxy [RunListener]
+              []
+            (testRunStarted [description]
+              (println "Running jUnit tests for"
+                       (str/join ", " packages)))
+
+            (testRunFinished [result]
+              (print "\n\n")
+              (print-ignored-tests @ignored-tests)
+              (print-failed-tests (.getFailures result))
+              (print-test-summary result))
+
+            (testStarted [description]
+              (swap! running-tests conj description))
+
+            (testIgnored [description]
+              (swap! ignored-tests conj description)
+              (print (style "*" :yellow)))
+
+            (testFinished [description]
+              (when (@running-tests description)
+                (swap! running-tests disj description)
+                (print (style "." :green))))
+
+            (testFailure [failure]
+              (let [description (.getDescription failure)]
+                (when (@running-tests description)
+                  (swap! running-tests disj description)
+                  (print (style "F" :red)))))))))))
+
+(defn build-package-config [^String package]
   (.. (ConfigurationBuilder.)
       (setUrls (ClasspathHelper/forPackage package (into-array ClassLoader [])))
       (setScanners (into-array Scanner [(TypeAnnotationsScanner.)
@@ -47,82 +121,25 @@
        (map path->package-name)
        set))

-(defn- print-ignored-tests [ignored-tests]
-  (when (seq ignored-tests)
-    (println "Ignored:")
-    (println)
-    (doseq [[i ignored] (map-indexed vector ignored-tests)]
-      (printf "  %d) %s\n"
-              (inc i) (style (.getDisplayName ignored) :yellow))
-      (println))))
-
-(defn- print-failed-tests [test-failures]
-  (when (seq test-failures)
-    (println "Failed:")
-    (println)
-    (doseq [[i failure] (map-indexed vector test-failures)]
-      (printf "  %d) %s\n"
-              (inc i) (.getTestHeader failure))
-      (printf "     %s\n" (style (.getTrace failure)
-                                 :red))
-      (println))))
-
-(defn- print-test-summary [result]
-  (printf "Finished in %s seconds\n" (float (/ (.getRunTime result) 1000)))
-  (let [run-count     (.getRunCount      result)
-        ignore-count  (.getIgnoreCount   result)
-        failure-count (.getFailureCount  result)
-        test-count (+ run-count ignore-count)]
-    (println (style (cl-format nil "~D test~:P, ~D failure~:P~[~;, ~:*~D ignored~]~%"
-                               test-count failure-count ignore-count)
-                    (if (> failure-count 0) :red :green)))))
-
-(defn- run-listener [packages]
-  (let [running-tests (atom #{})
-        ignored-tests (atom #{})]
-    (proxy [RunListener]
-        []
-      (testRunStarted [description]
-        (println "Running jUnit tests for "
-                 (str/join ", " packages)))
-
-      (testRunFinished [result]
-        (print "\n\n")
-        (print-ignored-tests @ignored-tests)
-        (print-failed-tests (.getFailures result))
-        (print-test-summary result))
-
-      (testStarted [description]
-        (swap! running-tests conj description))
-
-      (testIgnored [description]
-        (swap! ignored-tests conj description)
-        (print (style "*" :yellow)))
-
-      (testFinished [description]
-        (when (@running-tests description)
-          (swap! running-tests disj description)
-          (print (style "." :green))))
-
-      (testFailure [failure]
-        (let [description (.getDescription failure)]
-          (when (@running-tests description)
-            (swap! running-tests disj description)
-            (print (style "F" :red))))))))
-
 (core/deftask junit
   "Run the jUnit test runner."
   [p packages PACKAGE #{sym} "The set of Java packages to run tests in."]
-  (core/with-pre-wrap fileset
-    (let [packages (or (seq packages)
-                       (all-packages (core/input-files fileset)))]
-      (if (seq packages)
-        (let [^JUnitCore core (doto (JUnitCore.)
-                                (.addListener (run-listener packages)))
-              result (.run core
-                           (into-array Class
-                                       (find-all-tests packages)))]
-          (when (> (.getFailureCount result) 0)
-            (throw (ex-info "Some tests failed or errored" {}))))
-        (println "No packages were tested.")))
-    fileset))
+  (let [worker-pods (pod/pod-pool (update-in (core/get-env) [:dependencies] into pod-deps)
+                                  :init init)]
+    (core/cleanup (worker-pods :shutdown))
+    (core/with-pre-wrap fileset
+      (let [worker-pod (worker-pods :refresh)
+            packages (or (seq packages)
+                         (all-packages (core/input-files fileset)))]
+        (if (seq packages)
+          (let [result (pod/with-eval-in worker-pod
+                         (let [^JUnitCore core (doto (JUnitCore.)
+                                                 (.addListener (run-listener '~packages)))
+                               result (.run core
+                                            (into-array Class
+                                                        ~(find-all-tests packages)))]
+                           {:failures (.getFailureCount result)}))]
+            (when (> (:failures result) 0)
+              (throw (ex-info "Some tests failed or errored" {}))))
+          (println "No packages were tested.")))
+      fileset)))


Allow the user to specify the I/O encoding

Defaults to UTF-8.
Fixes #6

--HG--
branch : bleeding-edge

--- src/de/kotka/vimclojure/nails.clj
+++ src/de/kotka/vimclojure/nails.clj
@@ -40,29 +40,37 @@
   command-line arguments available according to the specification
   and the nailgun context as 'nailContext'."
   [nail usage arguments & body]
-  `(do
-     (gen-class
-       :name    ~(symbol (str "de.kotka.vimclojure.nails." (name nail)))
-       :prefix  ~(symbol (str (name nail) "-"))
-       :methods [#^{:static true}
-                 [~'nailMain [com.martiansoftware.nailgun.NGContext] ~'void]]
-       :main    false)
-
-     (defn ~(symbol (str (name nail) "-nailMain"))
-       ~usage
-       [~(with-meta 'nailContext {:tag 'NGContext})]
-       (binding [~'*in*  (-> ~'nailContext
-                           .in
-                           InputStreamReader.
-                           LineNumberingPushbackReader.)
-                 ~'*out* (-> ~'nailContext .out OutputStreamWriter.)
-                 ~'*err* (-> ~'nailContext .err PrintWriter.)]
-         (util/with-command-line (.getArgs ~'nailContext)
-           ~usage
-           ~arguments
-           ~@body)
-         (.flush *out*)
-         (.flush *err*)))))
+  (let [encoding (if-let [enc (System/getProperty "clojure.vim.encoding")]
+                   enc
+                   "UTF-8")]
+    `(do
+       (gen-class
+         :name    ~(symbol (str "de.kotka.vimclojure.nails." (name nail)))
+         :prefix  ~(symbol (str (name nail) "-"))
+         :methods [#^{:static true}
+                   [~'nailMain [com.martiansoftware.nailgun.NGContext] ~'void]]
+         :main    false)
+
+       (defn ~(symbol (str (name nail) "-nailMain"))
+         ~usage
+         [~(with-meta 'nailContext {:tag 'NGContext})]
+         (binding [~'*in*  (-> ~'nailContext
+                             .in
+                             (InputStreamReader. ~encoding)
+                             LineNumberingPushbackReader.)
+                   ~'*out* (-> ~'nailContext
+                             .out
+                             (OutputStreamWriter. ~encoding))
+                   ~'*err* (-> ~'nailContext
+                             .err
+                             (OutputStreamWriter. ~encoding)
+                             PrintWriter.)]
+           (util/with-command-line (.getArgs ~'nailContext)
+             ~usage
+             ~arguments
+             ~@body)
+           (.flush *out*)
+           (.flush *err*))))))

 (defnail DocLookup
   "Usage: ng de.kotka.vimclojure.nails.DocString [options]"


Cleaned up the util namespace.

Cleaned up the util namespace.

--- src/kosha/app/util.clj
+++ src/kosha/app/util.clj
@@ -1,45 +1,5 @@
 (ns kosha.app.util
-  (:require [clojure.string :as s]
-            [cheshire.core :as json])
-  (:import [java.util.concurrent
-            ThreadPoolExecutor
-            TimeUnit
-            ArrayBlockingQueue
-            ThreadPoolExecutor$CallerRunsPolicy]))
-
-;; public String unaccent(String s) {
-;;     String normalized = Normalizer.normalize(s, Normalizer.Form.NFD);
-;;     return normalized.replaceAll("[^\\p{ASCII}]", "");
-;; }
-
-(defn unaccent [s]
-  (let [normalized (java.text.Normalizer/normalize s java.text.Normalizer$Form/NFD)]
-    (.replaceAll normalized "[^\\p{ASCII}]" "")))
-
-(defn ->printable [swarams & {:keys [bold?]}]
-  (s/join ", " (map (comp s/capitalize name) swarams)))
-
-(defn display-ragam-name [ragam-name]
-  (s/capitalize (name ragam-name)))
-
-(defn create-fixed-threadpool [pool-size queue-size]
-  (ThreadPoolExecutor. pool-size  ;corePoolSize
-                       pool-size  ;maximumPoolSize
-                       60
-                       TimeUnit/SECONDS
-                       (ArrayBlockingQueue. queue-size true)
-                       ;; TODO: ask srihari why we chose this policy -nid/sd
-                       (ThreadPoolExecutor$CallerRunsPolicy.)))
-
-(defn run-in-parallel
-  "Runs tasks parallelly using a fixed threadpool and a bounded ArrayBlockingQueue,
-  where tasks are 0 argument functions."
-  [tasks pool-size queue-size]
-  (let [pool (create-fixed-threadpool pool-size queue-size)
-        rets (mapv #(.get %)
-                   (.invokeAll pool tasks))]
-    (.shutdown pool)
-    rets))
+  (:require [cheshire.core :as json]))

 (defn json-response [response]
   {:status 200


Byte arrays aren't helpful

Byte arrays aren't helpful

--- src/lazubot/docker.clj
+++ src/lazubot/docker.clj
@@ -100,6 +100,6 @@
          (>! (:in worker-doc) form)
          (let [[response channel] (alts! [(:out worker-doc) (timeout 10000)])]
            (if (= channel (:out worker-doc))
-             (>! result-channel response)
+             (>! result-channel (String. response))
              (replace-worker! worker-doc)))
          result-channel)))))


Added 'subtask not found' message (fixes #19)

--- src/leiningen/ring.clj
+++ src/leiningen/ring.clj
@@ -1,11 +1,11 @@
 (ns leiningen.ring
-  (:use [leiningen.help :only (help-for)]
+  (:use [leiningen.help :only (help-for subtask-help-for)]
         [leiningen.ring.server :only (server)]
         [leiningen.ring.server-headless :only (server-headless)]
         [leiningen.ring.war :only (war)]
         [leiningen.ring.uberwar :only (uberwar)]))

-(defn ring
+(defn ring
   "Manage a Ring-based application."
   {:help-arglists '([server server-headless war uberwar])
    :subtasks [#'server #'server-headless #'war #'uberwar]}
@@ -16,4 +16,6 @@
        "server"          (apply server project args)
        "server-headless" (apply server-headless project args)
        "war"             (apply war project args)
-       "uberwar"         (apply uberwar project args))))
+       "uberwar"         (apply uberwar project args)
+                         (println "Subtask" (str \" subtask \") "not found."
+                                  (subtask-help-for *ns* #'ring)))))


Add comments about 'compare-max and its usage.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1210,7 +1210,9 @@

 ;; ===== latest version querying =====

-(defn compare-max [& xs]
+(defn compare-max
+  "Max using general 'compare' instead of number-only 'max'."
+  [& xs]
   (when (seq xs)
     (reduce #(if (neg? (compare %1 %2)) %2 %1) xs)))

@@ -1287,6 +1289,8 @@
                                         candidate))
                                    shas-c)
                              (map (comp first sha-candidates-a) shas-c))
+              ;; Build a sequence of pairs, [parsed-version-object version-string],
+              ;; and find the max version object by comparison but keep version string:
               [_ max-ver-e] (apply compare-max
                                    (map #(vector (when % (.parseVersion gvs %)) %)
                                         (distinct (map :version candidates-d))))


Extract 'safe-delete-repo logic from box-repo-add.

This is in preparation for use in :box-remove.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -637,6 +637,15 @@
           path
           (recur (.getParentFile path)))))))

+(defn safe-delete-repo
+  [checkout pdir]
+  (if-let [dirty (dirty-repo? checkout)]
+          (do (println "Must clean up repo:" pdir)
+              (prn dirty)
+              (lmain/abort "Please fix."))
+          (do (sh "rm" "-f" pdir)
+              (sh "rm" "-rf" checkout))))
+
 (defn box-repo-add
   [{:keys [gitdir branch sha proj path]}]
   (if-let [bdir (find-box)]
@@ -648,14 +657,7 @@
           remote (-> (remotes gitdir) :origin :fetch)]
       (when (and (.exists ^File checkout)
                  (not= remote (-> (remotes (:gitdir g)) :origin :fetch)))
-        (if-let [dirty (dirty-repo? (:gitdir g))]
-          (do (println "Must clean up repo:" pdir)
-              (prn dirty)
-              (lmain/abort "Please fix."))
-          (do (sh "rm" "-f" pdir)
-              ;; TODO: change directory out of checkout directory and back.
-              #_(fcmd "cd 'somewhere/outside/of/checkout'")
-              (sh "rm" "-rf" checkout))))
+        (safe-delete-repo checkout pdir))
       (if (.exists ^File checkout)
         (git g "fetch")
         (git {} "clone" remote "--refer" gitdir checkout))


CW |0| remove work in progress in sign in page

--- src/stonecutter/view/sign_in.clj
+++ src/stonecutter/view/sign_in.clj
@@ -65,4 +65,5 @@
          set-form-action
          (add-sign-in-errors err)
          (add-params params)
+         vh/remove-work-in-progress
          vh/add-anti-forgery)))


Replace passwords with environment vars

Replace passwords with environment vars

--- src/sweng_hw6_grader/tidbits.clj
+++ src/sweng_hw6_grader/tidbits.clj
@@ -8,7 +8,7 @@
   "Get an OAuth2 token from GitHub"
   []
   (client/post "https://api.github.com/authorizations"
-               {:basic-auth ["Sjlver" "2wXVf3EBuySH"]
+               {:basic-auth ["Sjlver" (System/getenv "GITHUB_PASSWORD")]
                 :body (client/json-encode {:note "SwEng HW6 Grader"
                                            :scopes ["repo"]})
                 :debug true}))
@@ -23,7 +23,7 @@
     ([url params]
      (let [full-url (str "https://api.github.com" url)
            user-agent {"User-Agent" "SwEng HW6 Grader"}
-           full-params (conj {:oauth-token "c51e6e73fe7bf706942ef41eda1a10435d130027"
+           full-params (conj {:oauth-token (System/getenv "GITHUB_OAUTH_TOKEN")
                               :as :json
                               :headers user-agent} params)
            response (method full-url full-params)]


Fixed 'lein ring server' destroy hook

Fixed 'lein ring server' destroy hook

--- src/leiningen/ring/run_server.clj
+++ src/leiningen/ring/run_server.clj
@@ -19,8 +19,11 @@
     (try-ports #(jetty-server handler %)
                suitable-ports)))

-(defn run-server [handler port launch-browser? init-handler destroy-handler]
-  (when init-handler (init-handler))
+(defn run-server [handler port launch-browser? init-fn destroy-fn]
+  (when destroy-fn
+    (. (Runtime/getRuntime)
+       (addShutdownHook (Thread. destroy-fn))))
+  (when init-fn (init-fn))
   (let [server    (jetty-server handler port)
         connector (first (.getConnectors server))
         host      (or (.getHost connector) "0.0.0.0")
@@ -29,7 +32,4 @@
     (println "Started server on port" port)
     (when launch-browser?
       (browse-url (str "http://" url-host ":" port)))
-    (try
-      (.join server)
-      (finally
-       (when destroy-handler (destroy-handler))))))
+    (.join server)))


fix incremental JS compile issue

fix incremental JS compile issue

can't really do incremental compiles anymore. closure-compiler
is too picky about renaming rules and I can't find a way to cache
exports info for all namespaces or how to restore it so the
compiler actually uses it. fails with weird internal errors
when it doesn't get all the sources. the previous hacks used for
this no longer work.

only affects classpath JS so shouldn't be too much of an issue

--- src/main/shadow/build/closure.clj
+++ src/main/shadow/build/closure.clj
@@ -1324,7 +1324,7 @@
   "takes a list of :js sources and rewrites them to using closure
    partial compiles must supply the cached sources so closure doesn't complain about things
    it cannot resolve"
-  [{:keys [project-dir npm mode] :as state} sources cached-sources]
+  [{:keys [mode] :as state} sources]

   (let [source-files
         (for [{:keys [resource-name file] :as src} sources]
@@ -1361,21 +1361,12 @@
         source-file-names
         (into #{} (map #(.getName %)) source-files)

-        cached-source-files
-        (for [{:keys [resource-name ns] :as src} cached-sources]
-          ;; cannot pass the rewritten code in here again since closure identifies it as the wrong type
-          ;; previously it was an ES MODULE now its SCRIPT which blows up internally
-          ;; FIXME: figure out a more fool proof way of doing this or skip incremental compiles entirely
-          (closure-source-file resource-name
-            (str "goog.provide(\"" (cljs-comp/munge ns) "\");")))
-
         source-files
         ;; closure prepends polyfills to the first resource
         ;; adding an empty placeholder ensures we can take them out easily
         (-> [(closure-source-file polyfill-name "")]
             ;; then add all resources
             (into shadow-js-files)
-            (into cached-source-files)
             (into source-files))

         ;; this includes all files (sources + package.json files)
@@ -1625,10 +1616,9 @@
         need-compile?
         (boolean (seq recompile-sources))

-        ;; restore cached output so the convert can use it
         state
-        (if-not (seq cache-files)
-          state
+        (if-not need-compile?
+          ;; restore cached output, cannot do incremental compiled due to closure being picky about names
           (util/with-logged-time [state {:type ::closure-cache-read
                                          :num-files (count sources)}]
             (-> state
@@ -1649,18 +1639,15 @@
                             (assoc-in [:output resource-id] cached-output)
                             (update :js-properties set/union properties))
                         )))
-                  cache-files))))
-
-        state
-        (if-not need-compile?
-          state
-          (convert-sources* state recompile-sources cache-files))
+                  cache-files)))
+          ;; compile all again
+          (convert-sources* state sources))

         cache-index-updated
         (if-not need-compile?
           cache-index
           (util/with-logged-time [state {:type ::closure-cache-write
-                                         :num-files (count recompile-sources)}]
+                                         :num-files (count sources)}]
             (-> cache-index
                 (assoc :SHADOW-CACHE-KEY SHADOW-CACHE-KEY
                        :CACHE-OPTIONS cache-options
@@ -1677,7 +1664,7 @@
                       (cache/write-file cache-file output)

                       (assoc idx resource-id cache-key)))
-                  recompile-sources))))]
+                  sources))))]

     (when need-compile?
       (cache/write-file cache-index-file cache-index-updated))
@@ -1726,7 +1713,7 @@

 (defn convert-sources-simple*
   "takes a list of :npm sources and rewrites in a browser compatible way, no full conversion"
-  [{:keys [project-dir js-options npm mode build-sources] :as state} sources]
+  [{:keys [js-options mode] :as state} sources]
   (let [source-files
         (->> (for [{:keys [resource-id resource-name ns require-id file deps] :as src} sources]
                (let [source (data/get-source-code state src)
@@ -2107,7 +2094,6 @@
              #_(map #(do (println (.getCode %)) %))
              (into []))

-        ;; this includes all files (sources + package.json files)
         source-files-by-name
         (->> source-files
              (map (juxt #(.getName %) identity))


relax ns alias check for cljs.js can compile again

dunno why this is allowed

--- src/main/shadow/build/ns_form.clj
+++ src/main/shadow/build/ns_form.clj
@@ -276,7 +276,11 @@
 (defn check-alias-conflict! [ns-info ns alias]
   (let [conflict
         (or (get-in ns-info [:requires alias])
-            (get-in ns-info [:require-macros alias])
+            ;; apparently it is ok for :require-macros to clash with a regular alias? no need to check it then
+            ;; not sure why this is allowed
+            ;; https://github.com/clojure/clojurescript/blob/afe2cf748fb77c5194bac0608e32358e15da067d/src/main/cljs/cljs/js.cljs#L12
+            ;; https://github.com/clojure/clojurescript/blob/afe2cf748fb77c5194bac0608e32358e15da067d/src/main/cljs/cljs/js.cljs#L15
+            #_ (get-in ns-info [:require-macros alias])
             (get-in ns-info [:reader-aliases alias]))]
     (when (and conflict
                (not= conflict ns)


fix misplaced form

fix misplaced form

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -780,8 +780,8 @@

         (println "------------------------------------------------------------------------------")
         (println "   WARNING: shadow-cljs not installed in project.")
-        (println "   See https://shadow-cljs.github.io/docs/UsersGuide.html#project-install"))
-        (println "------------------------------------------------------------------------------"))
+        (println "   See https://shadow-cljs.github.io/docs/UsersGuide.html#project-install")
+        (println "------------------------------------------------------------------------------")))

     (catch :default e
       (println "WARNING: package.json not found. See https://shadow-cljs.github.io/docs/UsersGuide.html#project-install"))))


Added density to row

Added density to row

--- src/main/untangled/ui/layout.cljc
+++ src/main/untangled/ui/layout.cljc
@@ -19,16 +19,18 @@
   `:valign` can be :top, :middle, or :bottom and will affect the vertical positioning of nested cells that do not
   share a common height.
   "
-  [{:keys [distribute-extra-columns halign valign] :as props} & children]
+  [{:keys [distribute-extra-columns halign valign density] :as props} & children]
   {:pre [(contains? #{nil :between :around} distribute-extra-columns)
          (contains? #{nil :start :center :end} halign)
-         (contains? #{nil :top :middle :bottom} valign)]}
+         (contains? #{nil :top :middle :bottom} valign)
+         (contains? #{nil :collapse :wide :break} density)]}
   (let [className (or (:className props) "")
         classes   (cond-> className
                     :always (str " u-row")
                     distribute-extra-columns (str " u-" (name distribute-extra-columns))
                     halign (str " u-" (name halign))
-                    valign (str " u-" (name valign)))
+                    valign (str " u-" (name valign))
+                    density (str " u-row--" (name density)))
         attrs     (-> props
                     (dissoc :distribute-extra-columns)
                     (assoc :className classes)


what's up w/indentation?

what's up w/indentation?

--- tls.clj
+++ tls.clj
@@ -92,80 +92,80 @@
 ; purely academic exercise as the following would
 ; fail badly if m is negative
 (defn plus [n m]
-    (cond
-        (zero? m) n
-        :else (plus (add1 n) (sub1 m))))
+  (cond
+    (zero? m) n
+    :else (plus (add1 n) (sub1 m))))

 (defn minus [n m]
-    (cond
-        (zero? m) n
-        :else (minus (sub1 n) (sub1 m))))
+  (cond
+    (zero? m) n
+    :else (minus (sub1 n) (sub1 m))))

 (defn x [n m]
-    (cond
-        (zero? m) m
-        :else (+ n (x n (sub1 m)))))
+  (cond
+    (zero? m) m
+    :else (+ n (x n (sub1 m)))))

 (defn ↑ [n m]
-    (cond
-        (zero? m) 1
-        :else (* n (↑ n (sub1 m)))))
+  (cond
+    (zero? m) 1
+    :else (* n (↑ n (sub1 m)))))

 ; this is clean though
 (defn addtup [tup]
-    (cond
-        (null? tup) 0
-        :else (+ (first tup) (addtup (rest tup)))))
+  (cond
+    (null? tup) 0
+    :else (+ (first tup) (addtup (rest tup)))))

 (defn tup+ [tup1 tup2]
-    (cond
-        (null? tup1) tup2
-        (null? tup2) tup1
-        :else (cons (+ (first tup1) (first tup2))
-                    (tup+ (rest tup1) (rest tup2)))))
+  (cond
+    (null? tup1) tup2
+    (null? tup2) tup1
+    :else (cons (+ (first tup1) (first tup2))
+                (tup+ (rest tup1) (rest tup2)))))

 (defn myDiv [n m]
-    (cond
-        (< n m) 0
-        :else (add1 (myDiv (- n m) m))))
+  (cond
+    (< n m) 0
+    :else (add1 (myDiv (- n m) m))))

 (defn length [lat]
-    (cond
-        (null? lat) 0
-        :else (add1 (length (rest lat)))))
+  (cond
+    (null? lat) 0
+    :else (add1 (length (rest lat)))))

 (defn pick [n lat]
-    (cond
-        (null? lat) nil
-        (zero? (sub1 n)) (first lat)
-        :else (pick (sub1 n) (rest lat))))
+  (cond
+    (null? lat) nil
+    (zero? (sub1 n)) (first lat)
+    :else (pick (sub1 n) (rest lat))))

 (defn rempick [n lat]
-    (cond
-        (null? lat) nil
-        (= n 1) (rest lat)
-        :else (cons (first lat)
-                    (rempick (sub1 n) (rest lat)))))
+  (cond
+    (null? lat) nil
+    (= n 1) (rest lat)
+    :else (cons (first lat)
+                (rempick (sub1 n) (rest lat)))))

 (defn no-nums [lat]
-    (cond
-        (null? lat) []
-        (number? (first lat)) (no-nums (rest lat))
-        :else (cons (first lat)
-                    (no-nums (rest lat)))))
+  (cond
+    (null? lat) []
+    (number? (first lat)) (no-nums (rest lat))
+    :else (cons (first lat)
+                (no-nums (rest lat)))))

 (defn all-nums [lat]
-    (cond
-        (null? lat) []
-        (not (number? (first lat))) (all-nums (rest lat))
-        :else (cons (first lat)
-                    (all-nums (rest lat)))))
+  (cond
+    (null? lat) []
+    (not (number? (first lat))) (all-nums (rest lat))
+    :else (cons (first lat)
+                (all-nums (rest lat)))))

 (defn occur [a lat]
-    (cond
-        (null? lat) 0
-        (= (first lat) a) (add1 (occur a (rest lat)))
-        :else (occur a (rest lat))))
+  (cond
+    (null? lat) 0
+    (= (first lat) a) (add1 (occur a (rest lat)))
+    :else (occur a (rest lat))))

 (defn rember* [a l]
   (cond


Fix messaging gen test for new netty changes

--- test/onyx/messaging/messaging_gen_test.clj
+++ test/onyx/messaging/messaging_gen_test.clj
@@ -9,7 +9,7 @@
             [onyx.system :as system]
             [onyx.extensions :as ext]
             [onyx.api]
-            [onyx.types :refer [map->Leaf]]
+            [onyx.types :refer [map->Leaf map->Ack]]
             [com.stuartsierra.component :as component]
             [onyx.test-helper :refer [load-config]]
             [com.gfredericks.test.chuck :refer [times]]
@@ -31,23 +31,22 @@
   (fn [messenger _ _ _]
     (fn [^ChannelHandlerContext ctx ^ByteBuf buf]
       (try
-        (let [msg (protocol/read-buf (:decompress-f messenger) buf)]
-          (let [t ^byte (:type msg)]
-            (cond (= t protocol/messages-type-id)
-                  (doseq [message (:messages msg)]
-                    (swap! received update-in [:messages] conj message))
+        (let [t ^byte (protocol/read-msg-type buf)]
+          (cond (= t protocol/messages-type-id)
+                (doseq [message (protocol/read-messages-buf (:decompress-f messenger) buf)]
+                  (swap! received update-in [:messages] conj message))

-                  (= t protocol/ack-type-id)
-                  (swap! received update-in [:acks] into (:acks msg))
+                (= t protocol/ack-type-id)
+                (swap! received update-in [:acks] into (protocol/read-acks-buf buf))

-                  (= t protocol/completion-type-id)
-                  (swap! received update-in [:complete] conj (:id msg))
+                (= t protocol/completion-type-id)
+                (swap! received update-in [:complete] conj (protocol/read-completion-buf buf))

-                  (= t protocol/retry-type-id)
-                  (swap! received update-in [:retry] conj (:id msg))
+                (= t protocol/retry-type-id)
+                (swap! received update-in [:retry] conj (protocol/read-retry-buf buf))

-                  :else
-                  (throw (ex-info "Unexpected message received from Netty" {:message msg})))))
+                :else
+                (throw (ex-info "Unexpected message received from Netty" {:type t}))))
         (catch Throwable e
           (taoensso.timbre/error e)
           (throw e))))))
@@ -110,10 +109,12 @@
                 :payload
                 (gen/such-that not-empty
                                (gen/vector
-                                 (gen/hash-map
-                                   :id uuid-gen
-                                   :completion-id uuid-gen
-                                   :ack-val gen/int)))))
+                                 (gen/fmap
+                                   map->Ack
+                                   (gen/hash-map
+                                     :id uuid-gen
+                                     :completion-id uuid-gen
+                                     :ack-val gen/int))))))

 (def gen-completion
   (gen/hash-map :command
@@ -130,13 +131,12 @@
 (def gen-command
   (gen/one-of [gen-messages gen-acks gen-completion gen-retry]))

-#_(deftest messenger-gen-test
+(deftest messenger-gen-test
   (let [peer-group (onyx.api/start-peer-group peer-config)]
     (try
       (checking "all generated messages are received"
-                (times 500)
+                (times 20)
                 [commands (gen/vector gen-command)]
-                (println "Commands " commands)
                 (let [grouped-model (group-by :command commands)
                       model-results (zipmap (keys grouped-model)
                                             (map (fn [v] (set (flatten (map :payload v))))


Optimise telnet channels

Optimise telnet channels

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -318,7 +318,7 @@
                               [this :real-streams]
                               (conj real-streams stream-name)))))))))
   (create-virtual-stream-endpoint! [this stream-name]
-    (let [ch (chan (sliding-buffer 1))
+    (let [ch (chan)
           ch-mult (mult ch)]
       (dosync (alter state assoc-in [:virtual-streams stream-name]
                      {:channel ch :mult-channel ch-mult}))
@@ -365,7 +365,7 @@
           virtual-stream (get (:virtual-streams @state) projection-name)
           ch (:channel virtual-stream)
           mult-ch (:mult-channel virtual-stream)
-          telnet-tap (chan (sliding-buffer 1))
+          telnet-tap (chan)
           _ (log/info "Retrieving stream for" projection-name)
           new-descriptor (merge {:projection-name projection-name
                                  :fn (:persist function-descriptor)
@@ -508,7 +508,7 @@
                 text "streaming...")
       (go
         (loop [elem (<! ch)]
-          (if (not (empty? @sockets))
+          (when (not (empty? @sockets))
             (let [edn (prn-str elem)
                   bs (bytes (byte-array (map (comp byte int) edn)))]
               (dorun (pmap #(let [os (.getOutputStream %)]
@@ -530,8 +530,8 @@
   (let [c (chan 1)
         mult-global (mult c)
         global-channel {:channel c :mult-channel mult-global}
-        telnet-projections-channel (chan (sliding-buffer 1))
-        telnet-events-channel (chan (sliding-buffer 1))
+        telnet-projections-channel (chan (sliding-buffer 1024))
+        telnet-events-channel (chan (sliding-buffer 1024))
         telnet-mix (mix telnet-projections-channel)
         projection-channel (chan)
         projection-mix (mix projection-channel)


Call the correct function.

Call the correct function.

--- modules/web/src/immutant/web.clj
+++ modules/web/src/immutant/web.clj
@@ -56,4 +56,4 @@
   "Composes server and mount fns; ensures handler is var-quoted"
   [handler & opts]
   (let [h (if (symbol? handler) `(var ~handler) handler)]
-    `(mount-handler (server ~@opts) ~h ~@opts)))
+    `(mount (server ~@opts) ~h ~@opts)))


Fix #70 bug when explicitly serializing without prefixes

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -438,14 +438,16 @@
   ([destination & {:keys [append format encoding prefixes] :or {append false
                                                                 encoding "UTF-8"
                                                                 prefixes default-prefixes}}]
+
    (let [^RDFFormat format (resolve-format-preference destination format)
          writer (Rio/createWriter format
                                   (io/writer destination
                                              :append append
                                              :encoding encoding))]
      (reduce (fn [acc [name prefix]]
+               (println name prefix)
                (doto writer
-                 (.handleNamespace name prefix))) prefixes))))
+                 (.handleNamespace name prefix))) writer prefixes))))

 (def ^:no-doc format-supports-graphs #{RDFFormat/NQUADS
                                        RDFFormat/TRIX


Update cofx.cljc

Update cofx.cljc

--- src/re_frame/cofx.cljc
+++ src/re_frame/cofx.cljc
@@ -84,7 +84,7 @@
     :before  (fn coeffects-before
                [context]
                (if-let [handler (get-handler kind id)]
-                 (update context handler :coeffects)
+                 (update context :coeffects handler)
                  (console :error "No cofx handler registered for \"" id "\"")))))
   ([id value]
    (->interceptor


Reimpliment undo so as to handle explanations

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -1,38 +1,56 @@
 (ns re-frame.undo
   (:require-macros [reagent.ratom  :refer [reaction]])
   (:require
+    [re-frame.utils    :refer  [warn]]
     [reagent.core      :as     reagent]
     [re-frame.db       :refer  [app-db]]
     [re-frame.handlers :as     handlers]
-    [re-frame.subs     :as     subs ]))
+    [re-frame.subs     :as     subs]))

 ;; -- History -------------------------------------------------------------------------------------
 ;;
 ;;
 (def ^:private max-undos (atom 50))     ;; maximum number of undo states maintained
-(defn set-max-undos
+(defn set-max-undos!
   [n]
   (reset! max-undos n))

-;;
+
 (def ^:private undo-list (reagent/atom []))   ;; a list of history states
 (def ^:private redo-list (reagent/atom []))   ;; a list of future states, caused by undoing
+
+;; -- Explainations -----------------------------------------------------------
+;;
+;; Each undo has an associated explanation which can be displayed to the user.
+;;
+;; Seems really ugly to have mirrored vectors, but ...
+;; the code kinda falls out when you do. I'm feeling lazy.
+(def ^:private app-explain (reagent/atom ""))         ;; mirrors app-db
+(def ^:private undo-explain-list (reagent/atom []))   ;; mirrors undo-liat
+(def ^:private redo-explain-list (reagent/atom []))   ;; mirrors redo-list

 (defn clear-history!
   []
   (reset! undo-list [])
-  (reset! redo-list []))
+  (reset! redo-list [])
+  (reset! undo-explain-list [])
+  (reset! redo-explain-list []))

 (defn store-now!
   "stores the value currently in app-db, so the user can later undo"
-  []
+  [explanation]
   (reset! redo-list [])           ;; clear and redo state created by previous undos
+  (reset! redo-explain-list [])           ;; clear and redo state created by previous undos
   (reset! undo-list (vec (take
                            @max-undos
-                           (conj @undo-list @app-db)))))
+                           (conj @undo-list @app-db))))
+  (reset! undo-explain-list (vec (take
+                                   @max-undos
+                                   (conj @undo-explain-list @app-explain))))
+  (reset! app-explain explanation))

 (defn undos?
   []
@@ -60,23 +78,60 @@
     (reaction (redos?))))

+(subs/register
+  :undo-explantions
+  (fn handler
+    ; "returns a vector of string explnations
+    [_ _]
+    (reaction (deref undo-explain-list))))
+
+(subs/register
+  :redo-explantions
+  (fn handler
+    ; "returns a vector of string explnations
+    [_ _]
+    (reaction (deref redo-explain-list))))
+
 ;; -- event handlers  ----------------------------------------------------------------------------
+
+
+(defn undo
+  [undos cur redos]
+  (let [u @undos
+        r (cons @cur @redos)]
+    (reset! cur (last u))
+    (reset! redos r)
+    (reset! undos (pop u))))
+

 (handlers/register-base     ;; not a pure handler
   :undo                     ;; usage:  (dispatch [:undo])
   (fn handler
     [_ _]
-    (when (undos?)
-      (reset! redo-list (cons @app-db @redo-list))
-      (reset! app-db (last @undo-list))
-      (reset! undo-list (pop @undo-list)))))
+    (if-not (undos?)
+      (warn "re-frame: you did a (dispatch [:undo]), but there is nothing to undo.")
+      (do
+        (undo undo-list app-db redo-list)
+        (undo undo-explain-list app-explain redo-explain-list)))))
+
+
+(defn- redo
+  [undos cur redos]
+  (let [u (conj @undos @cur)
+        r  @redos]
+    (reset! cur (first r))
+    (reset! redos (rest r))
+    (reset! undos u)))
+

 (handlers/register-base     ;; not a pure handler
   :redo                     ;; usage:  (dispatch [:redo])
   (fn handler
     [_ _]
-    (when (redos?)
-      (reset! app-db (first @redo-list))
-      (reset! redo-list (rest @redo-list))
-      (reset! undo-list (conj @undo-list @app-db)))))
+    (if-not (redos?)
+      (warn "re-frame: you did a (dispatch [:redo]), but there is nothing to redo.")
+      (do
+        (redo undo-list app-db redo-list)
+        (redo undo-explain-list app-explain redo-explain-list)))))
+


add test code

add test code

--- src/sandbox/strategy/strategy.clj
+++ src/sandbox/strategy/strategy.clj
@@ -15,3 +15,10 @@
       (if (valid? person)
         (swap! valid-people conj person))
       @valid-people)))
+
+(def first-name-valid-collector (person-collector first-name-valid?))
+(def full-name-valid-collector (person-collector full-name-valid?))
+
+(def p1 {:first-name "john" :middle-name "quincy" :last-name "adams"})
+(def p2 {:first-name "mike" :middle-name nil :last-name "adams"})
+(def p3 {:first-name nil :middle-name nil :last-name nil})


Lots more options for netty tcp server

Lots more options for netty tcp server

--- src/riemann/server.clj
+++ src/riemann/server.clj
@@ -163,9 +163,12 @@
      ; Configure bootstrap
      (doto bootstrap
        (.setPipelineFactory cpf)
+       (.setOption "readWriteFair" true)
+       (.setOption "tcpNoDelay" true)
+       (.setOption "reuseAddress" true)
        (.setOption "child.tcpNoDelay" true)
-       (.setOption "child.keepAlive" true)
-       (.setOption "reuseAddress" true))
+       (.setOption "child.reuseAddress" true)
+       (.setOption "child.keepAlive" true))

      ; Start bootstrap
      (let [server-channel (.bind bootstrap


Minor doc cleanup

Minor doc cleanup

--- web/src/immutant/web/undertow.clj
+++ web/src/immutant/web/undertow.clj
@@ -26,15 +26,16 @@
            [org.projectodd.wunderboss.web Web$CreateOption Web$RegisterOption]))

 (defn ^HttpHandler http-handler
-  "Create an Undertow HttpHandler instance from a Ring handler function"
+  "Create an Undertow `HttpHandler` instance from a Ring handler function"
   [handler]
   (create-http-handler handler))

 (defn ^HttpHandler graceful-shutdown
-  "Creates an io.undertow.server.handlers/GracefulShutdownHandler with
-  the passed HttpHandler and returns it, after adding an at-exit fn
-  that prohibits new requests while waiting for pending ones to
-  complete, up to a specified number of milliseconds"
+  "Creates an `io.undertow.server.handlers/GracefulShutdownHandler`
+  with the passed `HttpHandler` and returns it, after adding an
+  `immutant.util/at-exit` fn that prohibits new requests while waiting
+  for pending ones to complete, up to a specified number of
+  milliseconds"
   [^HttpHandler handler ^Long timeout]
   (let [h (GracefulShutdownHandler. handler)]
     (at-exit (fn []


some more tests

some more tests

--- test/morpheus/tests/modeling.clj
+++ test/morpheus/tests/modeling.clj
@@ -43,7 +43,8 @@
     (fact "Read Edges"
           (let [morgan-freeman (vertex-by-key :people "Morgan Freeman")
                 batman-begins  (vertex-by-key :movie "Batman Begins")
-                oblivion       (vertex-by-key :movie "Oblivion")]
+                oblivion       (vertex-by-key :movie "Oblivion")
+                jeanette-adair-bradshaw (vertex-by-key :people "Jeanette Adair Bradshaw")]
             (neighbours morgan-freeman) => (contains [(contains {:*ep* (contains {:name :spouse, :type :indirected}), :*direction* :*neighbours*})
                                                       (contains {:*ep* (contains {:name :acted-in, :type :directed}), :*direction* :*outbounds*})]
                                                      :gaps-ok :in-any-order)
@@ -60,7 +61,10 @@
             (relationships batman-begins oblivion) => nil
             (linked? morgan-freeman batman-begins) => truthy
             (linked? morgan-freeman batman-begins :directions :*outbounds*) => truthy
-            (linked? morgan-freeman batman-begins :directions :*inbounds*) => falsey))
+            (linked? morgan-freeman batman-begins :directions :*inbounds*) => falsey
+            (linked? batman-begins morgan-freeman :directions :*inbounds*) => truthy
+            (linked-degree morgan-freeman jeanette-adair-bradshaw) => 1
+            (linked-degree jeanette-adair-bradshaw morgan-freeman) => 1))
     (fact "Update Defined Vertex"
           (update-vertex! (vertex-by-key :movie "Oblivion")
                           'clojure.core/assoc :year 2013) => anything)


remove stray require of pprint

remove stray require of pprint

--- src/tick/interval.cljc
+++ src/tick/interval.cljc
@@ -3,7 +3,6 @@
 (ns tick.interval
   (:refer-clojure :exclude [contains? complement partition-by group-by conj extend divide flatten])
   (:require
-    [clojure.pprint :refer [pprint]]
     [clojure.set :as set]
     [clojure.spec.alpha :as s]
     [tick.core :as t]


Added a useful comment about parameters provided by bidi

--- src/kixi/hecuba/web/resources.clj
+++ src/kixi/hecuba/web/resources.clj
@@ -78,6 +78,9 @@
     {:hecuba/id                  ; add this entry to Liberator's context
      (upsert! commander
               (merge
+               ;; Depending on the URI, the :hecuba/parent may already
+               ;; be known. If so, it can be set (but the merge will
+               ;; privilege any :hecuba/parent in the request body.
                route-params
                (-> body
                    ;; Prepare to read the body


sorted接口完成

sorted接口完成

--- src/learnclojure/chapt3/core5.clj
+++ src/learnclojure/chapt3/core5.clj
@@ -167,12 +167,27 @@
 ;;我们提拔方法>、>=、<、<=来指定需要的元素区间，其他比较器也是可以的

 ;;应用：线性牛顿插值
-(def m (into (sorted-map) (map vec [[0 0] [10 10] [15 5]])))
-(rsubseq m <= 2)
-(subseq m > 2)
+(defn interpolate
+  "take a collection of points,return a function which is a linear interpolation between those points."
+  [points]
+  (let [results (into (sorted-map) (map vec points))]
+    (fn [x]
+      (let [[xa ya] (first (rsubseq results <= x))
+            [xb yb] (first (subseq results > x))]
+        (if (and xa xb)
+          (/ (+ (* ya (- xb x)) (* yb (- x xa)))
+             (- xb xa))
+          (or ya yb))))))
+;;(map vec points)确保每个点都是vector表示的，从而可以加入map
+;;测试一下，有已知的三个点[0 0] [10 10] [15 5]
+(def f (interpolate [[0 0] [10 10] [15 5]]))
+(map f [2 10 12])
+;;=(2 10 8)
+;;perfect!

+


only add newlines to prompt in interactive mode.

--- src/leiningen/ancient/upgrade.clj
+++ src/leiningen/ancient/upgrade.clj
@@ -16,14 +16,16 @@

 (defn- prompt-for-upgrade!
   [artifact {:keys [opts]}]
-  (let [result (if (:include? artifact)
-                 (do
-                   (console/print-outdated-message artifact)
-                   (or (not (:interactive? opts))
-                       (console/prompt "Do you want to upgrade?")))
-                 (console/print-ignored-message artifact))]
-    (println)
-    result))
+  (if (:include? artifact)
+    (do
+      (console/print-outdated-message artifact)
+      (or (not (:interactive? opts))
+          (let [result (console/prompt "Do you want to upgrade?")]
+            (println)
+            result)))
+    (do (console/print-ignored-message artifact)
+        (if (:interactive? opts)
+          (println)))))

 (defn- as-string
   [upgraded]


updating example solution with suggestions from @haus

--- exercises/secret-handshake/src/example.clj
+++ exercises/secret-handshake/src/example.clj
@@ -6,9 +6,9 @@
       (reverse)))

 (defn- convert [integer]
-  (filter some?
+  (remove nil?
           (map (fn [command binary]
-                 (if (= \1 binary) command))
+                 (when (= \1 binary) command))
                ["wink" "double blink" "close your eyes" "jump"]
                (int->reversed-binary integer))))


disable js require removal

disable js require removal

there may be JS requires that only do side effects but are never used
in the actual code. so those must not be removed.

--- src/main/shadow/build/closure.clj
+++ src/main/shadow/build/closure.clj
@@ -1243,7 +1243,8 @@
             (= :js (get-in state [:build-options :module-format]))
             (-> (strip-dead-modules)
                 (module-wrap-npm)))
-          (handle-dead-js-requires)
+          ;; can't do this since there may be JS deps that are only there for the side effects
+          #_ (handle-dead-js-requires)
           (write-variable-maps)))))

 (def polyfill-name


Add test for update-oauth fn

Add test for update-oauth fn

--- test/myshelf/test/models/user.clj
+++ test/myshelf/test/models/user.clj
@@ -140,3 +140,30 @@
         (is (= new-tweet (:last_tweet updated-user)))
         (is (t/after? (tc/from-sql-time (:updated_at updated-user))
                       (tc/from-sql-time (:created_at updated-user))))))))
+
+(deftest t-update-oauth
+  ;; should create new user on first call
+  (let [handle "archimedes"
+        goodreads-id "42"
+        oauth-token "token"
+        oauth-token-secret "secret"]
+    (update-oauth handle goodreads-id oauth-token oauth-token-secret)
+    (let [new-user (find-by-handle handle)]
+      (is (= handle (:handle new-user)))
+      ;; user should have oauth set
+      (is (= oauth-token (:oauth_token new-user)))
+      (is (= oauth-token-secret (:oauth_token_secret new-user)))
+      (is (:created_at new-user))
+      (is (:updated_at new-user))
+      (is (= (:created_at new-user)
+             (:updated_at new-user))))
+    ;; should update the user on next call
+    (let [new-token "newtoken"
+          new-token-secret "newsecret"]
+      (update-oauth handle goodreads-id new-token new-token-secret)
+      (let [updated-user (find-by-handle handle)]
+        ;; oauth should match
+        (is (= new-token (:oauth_token updated-user)))
+        (is (= new-token-secret (:oauth_token_secret updated-user)))
+        (is (t/after? (tc/from-sql-time (:updated_at updated-user))
+                      (tc/from-sql-time (:created_at updated-user))))))))


Cosmetic.

Cosmetic.

--- test/onyx/peer/min_peers_test.clj
+++ test/onyx/peer/min_peers_test.clj
@@ -47,7 +47,7 @@
     :onyx/max-peers 1
     :onyx/doc "Writes segments to a core.async channel"}])

-(def workflow [[:in :inc][:inc :out]])
+(def workflow [[:in :inc] [:inc :out]])

 (def in-chan (chan (inc n-messages)))


refactor test blocks to store a line vector

--- test/parinfer/formatter_test.cljc
+++ test/parinfer/formatter_test.cljc
@@ -4,28 +4,28 @@
   (:require
     #?(:clj  [clojure.test :refer [is deftest]]
        :cljs [cljs.test :refer-macros [is deftest]])
-    [clojure.string :as string :refer [split-lines]]
+    [clojure.string :as string :refer [join split-lines]]
     [parinfer.format.infer :as infer]
     [parinfer.format.prep :as prep]))

 #?(:cljs (def fs (js/require "fs")))

 (defn error-msg
-  [line-no msg]
-  (str "error at test-case line #" line-no ": " msg))
+  [file-line-no msg]
+  (str "error at test-case line #" file-line-no ": " msg))

 (defmulti parse-test-line
-  (fn [state [line-no line]]
+  (fn [state [file-line-no line]]
     (cond
       (= "```" line)          :end-block
       (re-find #"^```" line)  :start-block
-      (:block-key state)      :in-block
+      (:block-key state)      :inside-block
       :else                   :default)))

 (defmethod parse-test-line :end-block
-  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
+  [{:keys [block-key test-case test-cases] :as state} [file-line-no line]]
   (if-not block-key
-    (throw (error-msg line-no "opening block must have a name: 'in' or 'out'"))
+    (throw (error-msg file-line-no "opening block must have a name: 'in' or 'out'"))
     (let [test-case-done? (:out test-case)]
       (if test-case-done?

@@ -39,36 +39,37 @@
         (assoc state :block-key nil)))))

 (defmethod parse-test-line :start-block
-  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
+  [{:keys [block-key test-case test-cases] :as state} [file-line-no line]]
   (if block-key
-    (throw (error-msg line-no "must close previous block before starting new one"))
+    (throw (error-msg file-line-no "must close previous block before starting new one"))
     (let [block-name (second (re-find #"^```(.*)$" line))
           block-key (keyword block-name)]
       (cond

         (not (#{:in :out} block-key))
-        (throw (error-msg line-no (str "block name " (pr-str block-name) "must be either 'in' or 'out'")))
+        (throw (error-msg file-line-no (str "block name " (pr-str block-name) "must be either 'in' or 'out'")))

         (and (= :in block-key) (:in test-case))
-        (throw (error-msg line-no (str "there is already an 'in' block for this test case.")))
+        (throw (error-msg file-line-no (str "there is already an 'in' block for this test case.")))

         (and (= :out block-key) (not (:in test-case)))
-        (throw (error-msg line-no (str "must include an 'in' block before an 'out' block.")))
+        (throw (error-msg file-line-no (str "must include an 'in' block before an 'out' block.")))

         :else
         (-> state
             (assoc :block-key block-key)
-            (assoc-in [:test-case block-key] {:line-no line-no :text ""}))))))
+            (assoc-in [:test-case block-key] {:file-line-no file-line-no
+                                              :lines []}))))))

-(defmethod parse-test-line :in-block
-  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
+(defmethod parse-test-line :inside-block
+  [{:keys [block-key test-case test-cases] :as state} [file-line-no line]]
   (let [cursor-x (.indexOf line "|")
         cursor-line (when (and (= :in block-key)
                                (not= -1 cursor-x))
-                      (- line-no (:line-no (:in test-case))))
+                      (dec (- file-line-no (:file-line-no (:in test-case)))))
         line (string/replace line "|" "")]
     (-> state
-        (update-in [:test-case block-key :text] str "\n" line)
+        (update-in [:test-case block-key :lines] conj line)
         (update-in [:test-case block-key :cursor-x] #(or % cursor-x))
         (update-in [:test-case block-key :cursor-line] #(or % cursor-line)))))

@@ -93,8 +94,8 @@
     (:test-cases state)))

 (defn idempotent-check
-  [type- message result state format-text]
-  (let [post-result (format-text state result)
+  [type- message result overrides format-text]
+  (let [post-result (format-text overrides result)
         message (str type- " idempotence over " message)]
     (is (= result post-result) message)))

@@ -103,20 +104,22 @@
   ([type- format-text post-test]
    (let [filename (str "doc/" type- "-tests.md")
          text #?(:clj (slurp filename)
-                      :cljs (.readFileSync fs filename))
+                 :cljs (.readFileSync fs filename))
          test-cases (parse-test-cases text)]
      (doseq [{:keys [in out]} test-cases]
        (let [cursor-line (:cursor-line in)
              cursor-x (:cursor-x in)
              cursor? (and cursor-line cursor-x)
-             state (select-keys in [:cursor-line :cursor-x])
-             message (cond-> (str type- " test case @ line #" (:line-no in))
+             overrides (select-keys in [:cursor-line :cursor-x])
+             message (cond-> (str type- " test case @ line #" (:file-line-no in))
                        cursor? (str " with cursor at line=" cursor-line " x=" cursor-x))
-             result (format-text state (:text in))]
-         (is (= (:text out) result))
-         (idempotent-check "infer" message result state infer/format-text)
+             text-in (join "\n" (:lines in))
+             text-out (join "\n" (:lines out))
+             result (format-text overrides text-in)]
+         (is (= text-out result))
+         (idempotent-check "infer" message result overrides infer/format-text)
          (when-not cursor?
-           (idempotent-check "prep" message result state prep/format-text)))))))
+           (idempotent-check "prep" message result overrides prep/format-text)))))))

 (deftest run-infer-cases
   (run-test-cases "infer" infer/format-text))


implement pre-cascade-delete for Dashboard :heart_eyes_cat:

--- src/metabase/models/dashboard.clj
+++ src/metabase/models/dashboard.clj
@@ -18,3 +18,6 @@
              :organization  (delay (sel :one Org :id organization_id))
              :ordered_cards (delay (sel :many DashboardCard :dashboard_id id (order :created_at :asc))))
       assoc-permissions-sets))
+
+(defmethod pre-cascade-delete Dashboard [_ {:keys [id]}]
+  (cascade-delete DashboardCard :dashboard_id id))


Title case on buttons

Title case on buttons

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -336,7 +336,7 @@

                (button/link {:kind :primary
                              :href (common/contact-support-a-info owner)}
-                            "Contact us for more")]
+                            "Contact Us For More")]

               (> parallelism (project-model/buildable-parallelism plan project))
               [:div.insufficient-containers
@@ -356,7 +356,7 @@
                          :href (routes/v1-org-settings-path {:org plan-org-name
                                                              :vcs_type plan-vcs-type
                                                              :_fragment "linux-pricing"})}
-                        "Add a plan")]))]
+                        "Add a Plan")]))]

      ;; Tell them to upgrade when they're using more parallelism than their plan allows,
      ;; but only on the tiles between (allowed parallelism and their current parallelism]
@@ -371,7 +371,7 @@
                       :href (routes/v1-org-settings-path {:org plan-org-name
                                                           :vcs_type plan-vcs-type
                                                           :_fragment "linux-pricing"})}
-                     "Upgrade plan")]))))
+                     "Upgrade Plan")]))))

 (defn get-offered-parallelism
   "In enterprise, offer whatever their plan's setting is (since they cannot upgrade).


Add a simple /ping route

Add a simple /ping route

--- src/org/spootnik/cyanite/http.clj
+++ src/org/spootnik/cyanite/http.clj
@@ -13,7 +13,8 @@
 (def
   ^{:doc "Our dead simple router"}
   routes [[:paths   #"^/paths.*"]
-          [:metrics #"^/metrics.*"]])
+          [:metrics #"^/metrics.*"]
+          [:ping #"^/ping/?"]])

 (defn now
   "Returns a unix epoch"
@@ -79,6 +80,10 @@
       (store/fetch store (or agg "mean") paths rollup period from to))
     {:step nil :from nil :to nil :series {}}))

+(defmethod process :ping
+  [_]
+  {})
+
 (defmethod process :default
   [_]
   (throw (ex-info "unknown action" {:status 404 :suppress? true})))


enable-repl-print no longer needed to catch eval printing

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -192,7 +192,6 @@
 (let [base-path (utils/base-url-path)]
   (defn eval-javascript** [code opts result-handler]
     (try
-      (enable-repl-print!)
       (let [sb (js/goog.string.StringBuffer.)]
         (binding [cljs.core/*print-newline* false
                   cljs.core/*print-fn* (fn [x] (.append sb x))]
@@ -214,12 +213,7 @@
          {:status :exception
           :ua-product (get-ua-product)
           :value (pr-str e)
-          :stacktrace "No stacktrace available."}))
-      (finally
-        ;; should we let people shoot themselves in the foot?
-        ;; you can theoretically disable repl printing in the repl
-        ;; but for now I'm going to prevent it
-        (enable-repl-print!)))))
+          :stacktrace "No stacktrace available."})))))

 (defn ensure-cljs-user
   "The REPL can disconnect and reconnect lets ensure cljs.user exists at least."


[#148] Delete all uncheked-* functions and replace their usage for the regular ones

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -909,8 +909,7 @@

 ;;math stuff
 (defn ^:private nary-inline
-  ([op] (nary-inline op op))
-  ([op unchecked-op]
+  ([op]
    (fn
      ([x] `(~op ~x))
      ([x y] `(~op ~x ~y))
@@ -937,14 +936,14 @@
 (defn +
   "Returns the sum of nums. (+) returns 0. Does not auto-promote
   longs, will throw on overflow. See also: +'"
-  {:inline (nary-inline 'add 'unchecked_add)
+  {:inline (nary-inline 'add)
    :inline-arities >1?
    :added "1.2"}
   ([] 0)
   ([x] x)
-  ([x y] (+' x y))
+  ([x y] (erlang/+.e x y))
   ([x y & more]
-   (reduce1 + (+ x y) more)))
+   (reduce1 erlang/+.2 (+ x y) more)))

 (defn *'
   "Returns the product of nums. (*) returns 1. Supports arbitrary precision.
@@ -961,7 +960,7 @@
 (defn *
   "Returns the product of nums. (*) returns 1. Does not auto-promote
   longs, will throw on overflow. See also: *'"
-  {:inline (nary-inline 'multiply 'unchecked_multiply)
+  {:inline (nary-inline 'multiply)
    :inline-arities >1?
    :added "1.2"}
   ([] 1)
@@ -997,7 +996,7 @@
   "If no ys are supplied, returns the negation of x, else subtracts
   the ys from x and returns the result. Does not auto-promote
   longs, will throw on overflow. See also: -'"
-  {:inline (nary-inline 'minus 'unchecked_minus)
+  {:inline (nary-inline 'minus)
    :inline-arities >0?
    :added "1.2"}
   ([x] (-' x))
@@ -1098,130 +1097,6 @@
   {:inline (fn [x] `(dec' ~x))
    :added "1.2"}
   [x] (dec' x))
-
-(defn unchecked-inc-int
-  "Returns a number one greater than x, an int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_inc ~x)))
-   :added "1.0"}
-  [x]
-  (inc x))
-
-(defn unchecked-inc
-  "Returns a number one greater than x, a long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x)))
-   :added "1.0"}
-  [x]
-  (inc x))
-
-(defn unchecked-dec-int
-  "Returns a number one less than x, an int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_dec ~x)))
-   :added "1.0"}
-  [x]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_dec x)))
-
-(defn unchecked-dec
-  "Returns a number one less than x, a long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x)))
-   :added "1.0"}
-  [x]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_dec x)))
-
-(defn unchecked-negate-int
-  "Returns the negation of x, an int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_negate ~x)))
-   :added "1.0"}
-  [x]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_negate x)))
-
-(defn unchecked-negate
-  "Returns the negation of x, a long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_minus ~x)))
-   :added "1.0"}
-  [x]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_minus x)))
-
-(defn unchecked-add-int
-  "Returns the sum of x and y, both int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_add ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_add x y)))
-
-(defn unchecked-add
-  "Returns the sum of x and y, both long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_add x y)))
-
-(defn unchecked-subtract-int
-  "Returns the difference of x and y, both int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_subtract ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_subtract x y)))
-
-(defn unchecked-subtract
-  "Returns the difference of x and y, both long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_minus ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_minus x y)))
-
-(defn unchecked-multiply-int
-  "Returns the product of x and y, both int.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_multiply ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_multiply x y)))
-
-(defn unchecked-multiply
-  "Returns the product of x and y, both long.
-  Note - uses a primitive operator subject to overflow."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_multiply x y)))
-
-(defn unchecked-divide-int
-  "Returns the division of x by y, both int.
-  Note - uses a primitive operator subject to truncation."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_divide ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_divide x y)))
-
-(defn unchecked-remainder-int
-  "Returns the remainder of division of x by y, both int.
-  Note - uses a primitive operator subject to truncation."
-  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_remainder ~x ~y)))
-   :added "1.0"}
-  [x y]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.Numbers (unchecked_int_remainder x y)))

 (defn pos?
   "Returns true if num is greater than zero, else false"
@@ -2680,7 +2555,7 @@
        (loop [~i 0]
          (when (< ~i n#)
            ~@body
-           (recur (unchecked-inc ~i)))))))
+           (recur (inc ~i)))))))

 (defn map
   "Returns a lazy sequence consisting of the result of applying f to
@@ -3212,7 +3087,7 @@
                            needrec (steppair 0)
                            subform (steppair 1)
                            recform-chunk
-                             `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-))
+                             `(recur ~seq- ~chunk- ~count- (inc ~i-))
                            steppair-chunk (step recform-chunk (nnext exprs))
                            subform-chunk (steppair-chunk 1)]
                        [true
@@ -3291,7 +3166,7 @@
        (loop [~i 0]
          (when (< ~i n#)
            ~@body
-           (recur (unchecked-inc ~i)))))))
+           (recur (inc ~i)))))))

 #_(defn into
   "Returns a new coll consisting of to-coll with all of the items of
@@ -3478,14 +3353,14 @@

 (defn short
   "Coerce to short"
-  {:inline (fn  [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedShortCast 'shortCast) ~x)))
+  {:inline (fn  [x] `(. clojure.lang.RT (~'shortCast ~x)))
    :added "1.0"}
   [^Number x]
   (throw "unsupported short"))

 (defn byte
   "Coerce to byte"
-  {:inline (fn  [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedByteCast 'byteCast) ~x)))
+  {:inline (fn  [x] `(. clojure.lang.RT (~'byteCast ~x)))
    :added "1.0"}
   [^Number x]
   (throw "unimplemented cast to byte")
@@ -3493,7 +3368,7 @@

 (defn char
   "Coerce to char"
-  {:inline (fn  [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedCharCast 'charCast) ~x)))
+  {:inline (fn  [x] `(. clojure.lang.RT (~'charCast ~x)))
    :added "1.1"}
   [x]
   (throw "unimplemented cast to char")
@@ -3504,62 +3379,6 @@
   {:inline (fn  [x] `(clj_core/boolean.e ~x))
    :added "1.0"}
   [x] (clj_core/boolean.e x))
-
-(defn unchecked-byte
-  "Coerce to byte. Subject to rounding or truncation."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedByteCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math"))
-
-(defn unchecked-short
-  "Coerce to short. Subject to rounding or truncation."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedShortCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math")
-  #_(clojure.lang.RT/uncheckedShortCast x))
-
-(defn unchecked-char
-  "Coerce to char. Subject to rounding or truncation."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedCharCast ~x)))
-   :added "1.3"}
-  [x]
-  (throw "unsupported unchecked math")
-  #_(. clojure.lang.RT (uncheckedCharCast x)))
-
-(defn unchecked-int
-  "Coerce to int. Subject to rounding or truncation."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedIntCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math")
-  #_(clojure.lang.RT/uncheckedIntCast x))
-
-(defn unchecked-long
-  "Coerce to long. Subject to rounding or truncation."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedLongCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math")
-  #_(clojure.lang.RT/uncheckedLongCast x))
-
-(defn unchecked-float
-  "Coerce to float. Subject to rounding."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedFloatCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math")
-  #_(clojure.lang.RT/uncheckedFloatCast x))
-
-(defn unchecked-double
-  "Coerce to double. Subject to rounding."
-  {:inline (fn  [x] `(. clojure.lang.RT (uncheckedDoubleCast ~x)))
-   :added "1.3"}
-  [^Number x]
-  (throw "unsupported unchecked math")
-  #_(clojure.lang.RT/uncheckedDoubleCast x))
-

 (defn number?
   "Returns true if x is a Number"
@@ -4649,12 +4468,12 @@
                                           (= k :when) `(if ~v
                                                          ~(do-cmod etc)
                                                          (recur
-                                                           (unchecked-inc ~gi)))
+                                                           (inc ~gi)))
                                           (keyword? k)
                                             (err "Invalid 'for' keyword " k)
                                           :else
                                             `(do (chunk-append ~gb ~body-expr)
-                                                 (recur (unchecked-inc ~gi)))))]
+                                                 (recur (inc ~gi)))))]
                           `(fn ~giter [~gxs]
                              (lazy-seq
                                (loop [~gxs ~gxs]
@@ -4864,6 +4683,9 @@
   ([s start] (subs s start (erlang/size.e s)))
   ([s start end] (binary/part.e s start (- end start))))

+(defn regex? [x]
+  (and (tuple? x) (= (first x) :re_pattern)))
+
 (defn re-run
   "Runs the matching of the pattern over the string using the provided
   options."
@@ -4880,7 +4702,7 @@
    :added "1.0"
    :static true}
   [s]
-  (if (and (tuple? s) (= (first s) :re_pattern))
+  (if (regex? s)
     s
     (second (re/compile.e s))))

@@ -5176,7 +4998,7 @@
            (if (< ~idx  (alength a#))
              (do
                (aset ~ret ~idx ~expr)
-               (recur (unchecked-inc ~idx)))
+               (recur (inc ~idx)))
              ~ret))))

     (defmacro areduce
@@ -5188,7 +5010,7 @@
       `(let [a# ~a l# (alength a#)]
          (loop  [~idx 0 ~ret ~init]
            (if (< ~idx l#)
-             (recur (unchecked-inc-int ~idx) ~expr)
+             (recur (inc-int ~idx) ~expr)
              ~ret))))

     (defn float-array
@@ -5705,7 +5527,7 @@
   "Same as (refer 'clojure.core <filters>)"
   {:added "1.0"}
   [& filters]
-  (apply refer 'clojure.core filters))
+  `(clojure.core/refer '~'clojure.core ~@filters))

 (defmacro defonce
   "defs name to have the root value of the expr iff the named var has no root value,
@@ -6267,12 +6089,12 @@
   print the result. expr's string representation will be produced
   using pr-str in any case."
   [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}]
-  (let [bs-str   (str bindings)
-        expr-str (str expr)]
+  (let [bs-str   (pr-str bindings)
+        expr-str (pr-str expr)]
     `(let ~bindings
        (let [start#   (erlang/monotonic_time.e :nano_seconds)
              ret#     (dotimes [_# ~iterations] ~expr)
              end#     (erlang/monotonic_time.e :nano_seconds)
              elapsed# (/ (- end# start#) 1000000)]
-         (~'println (str ~bs-str ", " ~expr-str ", "
+         (~'print-fn (str ~bs-str ", " ~expr-str ", "
                       ~iterations " runs, " elapsed# " msecs"))))))


streamparse.cli needs :gen-class

streamparse.cli needs :gen-class

--- jvm/src/streamparse/cli.clj
+++ jvm/src/streamparse/cli.clj
@@ -1,7 +1,8 @@
 (ns
   streamparse.cli
   (:require [clojure.pprint :as pp]
-            [clojure.string :as s]))
+            [clojure.string :as s])
+  (:gen-class:))

 (defn- tokenize-args
   "Reduce arguments sequence into [opt-type opt ?optarg?] vectors and a vector


(SERVER-1690) Improve CLI subcommand error handling

Previously, if some kinds of errors were thrown during the processing of
a CLI subcommand, e.g., a Prismatic schema error when parsing content
from the puppetserver.conf file, the resulting error displayed on the
command line had no indication of what the real error was.

This commit adds some extra error handling to the `run` function in the
CLI subcommand which, for cases like the schema error, allows the
original upstream exception passed through to the CLI output.  This
would allow the user to see more specific information about the root
cause behind the error.

--- src/clj/puppetlabs/puppetserver/cli/subcommand.clj
+++ src/clj/puppetlabs/puppetserver/cli/subcommand.clj
@@ -1,6 +1,6 @@
 (ns puppetlabs.puppetserver.cli.subcommand
   (:require [puppetlabs.kitchensink.core :as ks]
-            [slingshot.slingshot :refer [try+]]
+            [slingshot.slingshot :refer [try+ throw+]]
             [puppetlabs.trapperkeeper.config :as tk-config]
             [puppetlabs.i18n.core :as i18n]))

@@ -23,6 +23,13 @@
           (tk-config/load-config)
           (assoc :debug debug?)))))

+(defn print-message-and-exit
+  [error-map exit-code]
+  (if-let [msg (:msg error-map)]
+    (println msg)
+    (println error-map))
+  (System/exit exit-code))
+
 (defn run
   "The main entry for subcommands, this parses the `args` provided on the
    command line and prints out a message if there's any missing or incorrect.
@@ -32,13 +39,16 @@
    The `run-fn` must accept a configuration map and argument sequence."
   [run-fn args]
   (try+
-    (let [[config extra-args help] (-> (or args '())
-                                       (parse-cli-args!))]
+    (let [[config extra-args] (-> (or args '())
+                                  (parse-cli-args!))]
       (run-fn (load-tk-config config) extra-args))
     (catch map? m
-      (println (:msg m))
-      (case (ks/without-ns (:kind m))
-        :cli-error (System/exit 1)
-        :cli-help  (System/exit 0)))
+      (let [kind (:kind m)]
+        (if (keyword? kind)
+          (case (ks/without-ns kind)
+            :cli-error (print-message-and-exit m 1)
+            :cli-help (print-message-and-exit m 0)
+            nil)))
+      (throw+))
     (finally
       (shutdown-agents))))


♻ Extract run-process-managers!

♻ Extract run-process-managers!

Why:
- Reduces the scope of *transient-events to a single non-looping
  function call.
- Allows looping the whole `refresh-now!`, including `apply-new-events`,
  which likely will be required later when we start having commands
  which produce persistent events in the same loop.

--- src/territory_bro/projections.clj
+++ src/territory_bro/projections.clj
@@ -61,36 +61,31 @@
                               (db/with-db [conn {}]
                                 (gis-user/ensure-absent! conn args)))})

-(defn- get-and-reset! [*atom new-value]
-  (let [[old-value _] (reset-vals! *atom new-value)]
-    old-value))
+(defn- run-process-managers! [state]
+  (let [*transient-events (atom [])
+        dispatch-transient-event! (fn dispatch-transient-event! [event]
+                                    (assert (:event/transient? event) {:event event})
+                                    (swap! *transient-events conj event))
+        db-admin-injections (assoc db-admin-injections :dispatch! dispatch-transient-event!)]
+
+    (db-admin/process-pending-changes! state db-admin-injections)
+
+    (seq @*transient-events)))

 (defn refresh-now! []
   (let [cached @*cache
         updated (db/with-db [conn {:read-only? true}]
-                  (apply-new-events cached conn))
-        *transient-events (atom [])
-        dispatch-transient-event! (fn dispatch-transient-event! [event]
-                                    (assert (:event/transient? event) {:event event})
-                                    (swap! *transient-events conj event))
-        db-admin-injections (assoc db-admin-injections :dispatch! dispatch-transient-event!)]
-    (loop []
-      (when-not (identical? cached updated)
-        ;; with concurrent requests, only one of them will update the cache
-        (when (compare-and-set! *cache cached updated)
-          (log/info "Updated from revision" (:event/global-revision (:last-event cached))
-                    "to" (:event/global-revision (:last-event updated)))))
+                  (apply-new-events cached conn))]
+    (when-not (identical? cached updated)
+      ;; with concurrent requests, only one of them will update the cache
+      (when (compare-and-set! *cache cached updated)
+        (log/info "Updated from revision" (:event/global-revision (:last-event cached))
+                  "to" (:event/global-revision (:last-event updated)))))

-      (let [transient-events (get-and-reset! *transient-events [])]
-        (when-not (empty? transient-events)
-          (swap! *cache apply-events transient-events)
-          (log/info "Updated with" (count transient-events) "transient events")))
-
-      ;; run process managers
-      (db-admin/process-pending-changes! (cached-state) db-admin-injections)
-
-      (when-not (empty? @*transient-events)
-        (recur)))))
+    (when-some [transient-events (run-process-managers! (cached-state))]
+      (swap! *cache apply-events transient-events)
+      (log/info "Updated with" (count transient-events) "transient events")
+      (recur))))

 (mount/defstate refresher
   :start (poller/create (fn []


Fix unit test

Fix unit test

The Cron component is immutable, so the right approach is to thread it
through the calls to `start` and `stop`.

--- test/org/zalando/stups/friboo/system/cron_test.clj
+++ test/org/zalando/stups/friboo/system/cron_test.clj
@@ -1,7 +1,8 @@
 (ns org.zalando.stups.friboo.system.cron-test
   (:require [org.zalando.stups.friboo.system.cron :refer :all]
             [clojure.test :refer :all]
-            [overtone.at-at :as at]))
+            [overtone.at-at :as at]
+            [com.stuartsierra.component :as component]))

 (def-cron-component TestCron [state]
   (at/at (at/now) (job deliver state 42) pool))
@@ -10,7 +11,8 @@
   ;; Here we make sure that the component is started and stopped properly.
   (let [state (promise)
         cron-component (map->TestCron {:state state})]
-    (.start cron-component)
-    (.stop cron-component)
-    (.stop cron-component) ; stopping twice shouldn't break anything
+    (-> cron-component
+        component/start
+        component/stop
+        component/stop) ; stopping twice shouldn't break anything
     (is (= 42 (deref state 500 :not-delivered)))))


cleaned stress test printing

cleaned stress test printing

--- test/acceptance/stress_tests.clj
+++ test/acceptance/stress_tests.clj
@@ -1,5 +1,5 @@
 (ns acceptance.stress-tests
-  (:require [push.instructions.dsl :as [dsl]]
+  (:require [push.instructions.dsl :as dsl]
             [push.instructions.core :as instr]
             [push.types.core :as types]
             [push.util.stack-manipulation :as u]
@@ -167,6 +167,7 @@
                   (println (str n
                                 "  "
                                 (:counter s)
+
                                 (reduce-kv
                                   (fn [line k v]
                                     (str line "," (count (get-in s [:stacks k]))))


Changes related to clojure r1094

Changes related to clojure r1094

--- rosado/processing.clj
+++ rosado/processing.clj
@@ -9,9 +9,9 @@
 ;; agreeing to be bound by the terms of this license.  You must not
 ;; remove this notice, or any other, from this software.

-(clojure/ns rosado.processing
-			(:import (processing.core PApplet PImage PGraphics PFont))
-			(:load "constants.clj"))
+(ns rosado.processing
+  (:import (processing.core PApplet PImage PGraphics PFont))
+  (:load "constants"))

 ;; used by functions in this lib. Use binding to set it
 ;; to an instance of processing.core.PApplet


removed tests in forma.ops.classify-test that rely on old sequence files

--- test/forma/ops/classify_test.clj
+++ test/forma/ops/classify_test.clj
@@ -26,32 +26,10 @@
 (defn- generate-betas
   "Returns a source of the estimated coefficient vectors for each
   ecoregion (and spatial resolution, but this is ignored here)."
-  [{:keys [convergence-thresh t-res ridge-const est-start
-  max-iterations]} src]
+  [{:keys [convergence-thresh t-res ridge-const est-start  max-iterations]} src]
   (let [first-idx (date/datetime->period t-res est-start)]
     (<- [?s-res ?eco ?beta]
         (src ?s-res ?pd ?mod-h ?mod-v ?s ?l ?val ?neighbor-val ?eco ?hansen)
         (logistic-beta-wrap [ridge-const convergence-thresh max-iterations]
                                 ?hansen ?val ?neighbor-val :> ?beta)
         (:distinct false))))
-
-(fact "Check the structural (and numerical) stability of the output
-  from the beta generation queries."
-  (let [src (hfs-seqfile (t/test-path "beta-data-path"))
-        [sres eco beta] (ffirst (??- (generate-betas test-map src)))
-        fire-val (thrift/FireValue* 1 1 1 1)
-        forma-val (thrift/FormaValue* fire-val 3.0 3.0 3.0 3.0)
-        neighbor-val (thrift/NeighborValue* fire-val 1 2.0 3.0 4.0 5.0 6.0 7.0)]
-    eco => 40157
-    (first beta) => (roughly -8.206515)
-    (last beta)  => (roughly 1.1485239)
-
-    ;; Test that the resulting probablities from the estimated beta
-    ;; coefficients yield expected results.
-    (logistic-prob-wrap beta forma-val neighbor-val) => [2.88252532638858E-5]))
-
-(fact "Ensure that `beta-dict` contains the keys for the two
-  ecoregions in the test data set."
-  (let [src (hfs-seqfile (t/test-path "beta-data-path"))
-        beta-src (generate-betas test-map src)]
-    (set (keys (beta-dict beta-src))) => (set [:40160 :40157])))


OO: Test answer->color

OO: Test answer->color

--- test/hatti/utils/style_test.cljs
+++ test/hatti/utils/style_test.cljs
@@ -1,10 +1,12 @@
 (ns hatti.utils.style-test
   (:require-macros [cljs.test :refer [is deftest testing]])
   (:require [clojure.string :refer [join]]
-            [hatti.utils.style :refer [customizable-style?
+            [hatti.utils.style :refer [answer->color
+                                       customizable-style?
                                        get-css-rule-map
                                        group-user-defined-colors-by-answer
                                        group-user-defined-styles-by-answer
+                                       qualitative-palette
                                        user-customizable-styles]]))

 (def customizable-style [(first user-customizable-styles)
@@ -21,13 +23,16 @@
 (def css-rule-map
   {(-> customizable-style first keyword) "style-definition"})

+(def answers
+  [{:appearance "color:green;font-weight:bold;"
+    :name "good"}
+   {:appearance "color:red;"
+    :name "bad"}])
+
 (def field {:name field-name
             :full-name field-name
-            :type "select_one"
-            :children [{:appearance "color:green;font-weight:bold;"
-                        :name "good"}
-                       {:appearance "color:red;"
-                        :name "bad"}]})
+            :type "select one"
+            :children answers})

 (deftest test-customizable-style?
   (testing "returns whether a style representation is customizable"
@@ -50,3 +55,17 @@
   (testing "returns a map of answer to color"
     (is (= (group-user-defined-colors-by-answer field)
            {"good" "green" "bad" "red"}))))
+
+(deftest test-answer->color
+  (testing "returns a map of answer to color if field is select-one
+            and all children have an appearance attribute"
+    (is (= (answer->color field answers)
+           {"good" "green" "bad" "red"})))
+  (testing "returns a map of answer to color based on the qualitative palette
+            if the choices do not all have appearance attributes"
+    (let [answers-to-test (assoc-in answers [1 :appearance] nil)
+          field-to-test (assoc field :children answers-to-test)
+          [good-choice bad-choice] answers-to-test
+          [good-color bad-color] qualitative-palette]
+      (is (= (answer->color field-to-test answers-to-test)
+             {good-choice good-color bad-choice bad-color})))))


Fetch page on startup

Fetch page on startup

--- tutorial.moan/src/tutorial/moan/frontend/main.cljs
+++ tutorial.moan/src/tutorial/moan/frontend/main.cljs
@@ -159,7 +159,7 @@
   (init @state))

 ;; this only gets called once
-(defonce start-up (do (mount @state) true))
+(defonce start-up (do (init @state) true))

 (add-watch state
            ::rerender


New test test-contains-NPE

New test test-contains-NPE

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -214,3 +214,10 @@
             true  (contains "Hello world!" "o w")
             true  (contains "Hello world!" "world!"))))

+(deftest test-contains-NPE
+    "Check the function zg.utils/contains."
+    (testing "the function zg.utils/contains."
+        (is (thrown? NullPointerException (contains nil "")))
+        (is (thrown? NullPointerException (contains "" nil)))
+        (is (thrown? NullPointerException (contains nil nil)))))
+


Bumps version to 1.48.5-SNAPSHOT

Bumps version to 1.48.5-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.48.4"
+(defproject cook "1.48.5-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Add requirement of raise (#1936)

Add requirement of raise (#1936)

--- src-cljs/frontend/components/pages/add_projects.cljs
+++ src-cljs/frontend/components/pages/add_projects.cljs
@@ -1,5 +1,6 @@
 (ns frontend.components.pages.add-projects
-  (:require [frontend.components.add-projects :as add-projects]
+  (:require [frontend.async :refer [raise!]]
+            [frontend.components.add-projects :as add-projects]
             [frontend.components.pieces.button :as button]
             [frontend.components.templates.main :as main-template]
             [frontend.utils.launchdarkly :as ld]


Inbox: Allow custom UI for columns.

Inbox: Allow custom UI for columns.

--- src-cljs/pepa/workflows/inbox2.cljs
+++ src-cljs/pepa/workflows/inbox2.cljs
@@ -27,6 +27,12 @@
   ;; TODO: Handle immutable column sources
   ;; TODO: How do we handle removal of the last page for documents?
   (remove-pages! [_ state page-ids]))
+
+(defprotocol SpecialColumn
+  (special-column-ui [_]))
+
+(defn special-column? [x]
+  (satisfies? SpecialColumn x))

 (defprotocol ColumnDropTarget
   (accept-drop! [_ state pages target-idx]))
@@ -105,7 +111,11 @@
     (assert (number? document-id))
     (api/fetch-documents! [document-id])))

+(declare new-document-ui)
+
 (defrecord NewDocumentColumnSource [id]
+  SpecialColumn
+  (special-column-ui [_] new-document-ui)
   ColumnSource
   (column-title [_ _]
     "Create New Document")
@@ -193,7 +203,7 @@
   [page selected-pages]
   (assoc page :selected? (contains? (set selected-pages) (:id page))))

-(ui/defcomponent inbox-column [[state column] owner opts]
+(ui/defcomponent inbox-column [[state column] owner]
   (init-state [_]
     {:selection (->> (column-pages column state)
                      (map :id)
@@ -247,6 +257,27 @@
                                  (assoc :dragover? (= drop-idx (:idx page) ))
                                  (mark-page-selected (:selected selection))))}))]]))

+(ui/defcomponent new-document-ui [[state column] owner]
+  (render-state [_ {:keys [handle-drop!]}]
+    [:.column {:on-drag-over (fn [e] (.preventDefault e))
+               :on-drop (fn [e]
+                          (println "[new-document-ui] on-drop")
+                          (let [source-column (get-transfer-data e "application/x-pepa-column")
+                                page-ids (get-transfer-data e "application/x-pepa-pages")]
+                            ;; Delegate to `inbox'
+                            (handle-drop! (:id column)
+                                          source-column
+                                          page-ids
+                                          0)))}
+     [:header
+      (column-title column state)]
+     [:.center
+      "Drag pages here or press \"Open to open a file or document"
+      [:button {:on-click (fn [e]
+                            (ui/cancel-event e)
+                            (add-column! (current-columns state) [:document 1]))}
+       "Open"]]]))
+
 (defn ^:private inbox-handle-drop! [state owner page-cache target source page-ids target-idx]
   (let [columns (om/get-state owner :columns)
         target  (first (filter #(= (:id %) target) columns))
@@ -359,7 +390,13 @@
     ;; contains IDs)
     (let [page-cache (make-page-cache state columns)]
       [:.workflow.inbox
-       (om/build-all inbox-column columns
-                     {:fn (fn [column]
-                            [state (assoc column ::page-cache page-cache)])
-                      :state {:handle-drop! (partial inbox-handle-drop! state owner page-cache)}})])))
+       (map (fn [x i]
+              (om/build (if (special-column? x)
+                          (special-column-ui x)
+                          inbox-column)
+                        (assoc x :om.fake/index i)
+                        {:fn (fn [column]
+                               [state (assoc column ::page-cache page-cache)])
+                         :state {:handle-drop! (partial inbox-handle-drop! state owner page-cache)}}))
+            columns
+            (range))])))


Add minikanren day 1 hard

Add minikanren day 1 hard

--- minikanren/day1/src/day1/core.clj
+++ minikanren/day1/src/day1/core.clj
@@ -78,3 +78,14 @@
     (fresh [p y]
       (turingo p y)
       (== q [p y]))))
+
+; Write a relation called extendo, which works like the built-in appendo, mentioned in the easy problems.
+(defn extendo [x y z]
+  (conde
+    [(== x ()) (== y z)]
+    [(fresh [a d r]
+      (conso a d x)
+      (conso a r z)
+      (extendo d y r)
+      )]
+    ))