(PE-3909) Wrap try/catch for error test around bootstrap

This commit updates the `test-error-during-init` jruby-puppet-service
test to wrap a try/catch for an expected initialization exception around
the bootstrap for the application rather than just the run-app phase.

This change is necessary because an exception may be propagated up during
the bootstrap phase rather than the run-app phase if the call to
`create-jruby-instance` from a future during initialization happens to
be really fast.

--- test/puppetlabs/master/services/jruby/jruby_puppet_service_test.clj
+++ test/puppetlabs/master/services/jruby/jruby_puppet_service_test.clj
@@ -25,20 +25,22 @@
     (logging/with-test-logging
       (with-redefs [jruby-puppet-core/create-jruby-instance
                     (fn [_] (throw (Exception. "42")))]
-                   (bootstrap/with-app-with-config
-                     app
-                     [jruby-puppet-pooled-service]
-                     jruby-service-test-config
-                     (let [got-expected-exception (atom false)]
-                       (try
-                         (tk/run-app app)
-                         (catch Exception e
-                           (let [cause (stacktrace/root-cause e)]
-                             (is (= (.getMessage cause) "42"))
-                             (reset! got-expected-exception true))))
-                       (is (true? @got-expected-exception))
-                       (is (logged? #"^shutdown-on-error triggered because of exception!"
-                                    :error))))))))
+                   (let [got-expected-exception (atom false)]
+                     (try
+                       (bootstrap/with-app-with-config
+                         app
+                         [jruby-puppet-pooled-service]
+                         jruby-service-test-config
+                         (tk/run-app app))
+                       (catch Exception e
+                         (let [cause (stacktrace/root-cause e)]
+                           (is (= (.getMessage cause) "42"))
+                           (reset! got-expected-exception true))))
+                     (is (true? @got-expected-exception)
+                                "Did not get expected exception."))
+                   (is (logged?
+                         #"^shutdown-on-error triggered because of exception!"
+                                :error))))))

 (deftest test-pool-size
   (testing "The pool is created and the size is correctly reported"


Eval the schema at the caller

Eval the schema at the caller

--- src/icecap/handlers/core.clj
+++ src/icecap/handlers/core.clj
@@ -51,13 +51,12 @@
   implicitly added.
   "
   [type schema & fn-tail]
-  (let [full-schema (assoc schema :type (s/eq type))]
-    `(do
-       (defmethod get-schema ~type
-         [type#]
-         ~full-schema)
-       (defmethod execute ~type
-         ~@fn-tail))))
+  `(let [full-schema# (assoc ~schema :type (s/eq type))]
+     (defmethod get-schema ~type
+       [type#]
+       full-schema#)
+     (defmethod execute ~type
+       ~@fn-tail)))

 (defstep :succeed
   {(s/optional-key :name) s/Str}


Curious about Clojurescript, transpiled my code and it worked - awesome


Clean up service after k8s custom image test (#612)

--- waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
+++ waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
@@ -52,15 +52,14 @@
     (when (using-k8s? waiter-url)
       (let [custom-image (System/getenv "INTEGRATION_TEST_CUSTOM_IMAGE")
             _ (is (not (string/blank? custom-image)) "You must provide a custom image in the INTEGRATION_TEST_CUSTOM_IMAGE environment variable")
-            {:keys [body]} (make-kitchen-request
-                             waiter-url
-                             {:x-waiter-name (rand-name)
-                              :x-waiter-image custom-image
-                              :x-waiter-cmd "echo -n $INTEGRATION_TEST_SENTINEL_VALUE > index.html && python3 -m http.server $PORT0"
-                              :x-waiter-health-check-url "/"}
-                             :method :get
-                             :path "/")]
-        (is (= "Integration Test Sentinel Value" body))))))
+            {:keys [body service-id]} (make-request-with-debug-info
+                                        {:x-waiter-name (rand-name)
+                                         :x-waiter-image custom-image
+                                         :x-waiter-cmd "echo -n $INTEGRATION_TEST_SENTINEL_VALUE > index.html && python3 -m http.server $PORT0"
+                                         :x-waiter-health-check-url "/"}
+                                        #(make-kitchen-request waiter-url % :method :get :path "/"))]
+        (is (= "Integration Test Sentinel Value" body))
+        (delete-service waiter-url service-id)))))

 (deftest ^:parallel ^:integration-slow ^:resource-heavy test-s3-logs
   (testing-using-waiter-url


fix node-script builds broken by previous commit

introduced an extra newline which caused hashbang issues

--- src/main/shadow/build/output.clj
+++ src/main/shadow/build/output.clj
@@ -263,12 +263,9 @@
     (get mod :output-type ::default)))

 (defn finalize-module-output
-  [state {:keys [goog-base prepend output append sources] :as mod}]
-  (let [any-shadow-js?
-        (->> (data/get-build-sources state)
-             (some #(= :shadow-js (:type %))))
-
-        shadow-js-outputs
+  [{:keys [polyfill-js] :as state}
+   {:keys [goog-base prepend output append sources] :as mod}]
+  (let [shadow-js-outputs
         (->> sources
              (map #(data/get-source-by-id state %))
              (filter #(= :shadow-js (:type %)))
@@ -295,7 +292,8 @@
           (str (when (or (nil? prepend)
                          (not (str/includes? prepend "shadow$provide")))
                  "var shadow$provide = {};\n")
-               (:polyfill-js state) "\n"))
+               (when (seq polyfill-js)
+                 (str polyfill-js "\n"))))

         final-output
         (str base-prepend


iff specials

iff specials

--- src/latte/prop.clj
+++ src/latte/prop.clj
@@ -112,7 +112,6 @@
            H (not A)]
     (have a absurd :by (H x))
     (qed a)))
-

 (definition truth
   "Logical truth."
@@ -503,10 +502,7 @@
     (qed <e>)))

 (defthm or-sym
-  "Symmetry of disjunction.
-
-Remark: the proof for this theorem illustrates the non-trivial
-characteristic of or-elimination."
+  "Symmetry of disjunction."
   [[A :type] [B :type]]
   (==> (or A B)
        (or B A)))
@@ -519,6 +515,22 @@
     (have a _ :by (H1 D))
     (have b D :by (a H3 H2))
     (qed b)))
+
+(defspecial or-sym%
+  "Symmetry of disjunction, a special version of [[or-sym]]."
+  [def-env ctx or-term]
+  (let [[status ty] (ty/type-of-term def-env ctx or-term)]
+    (if (= status :ko)
+      (throw (ex-info "Cannot type term." {:special 'latte.prop/or-sym%
+                                           :term or-term
+                                           :from ty}))
+      (do
+        (let [[status A B] (decompose-or-type def-env ctx ty)]
+          (if (= status :ko)
+            (throw (ex-info "Not an `or`-type." {:special 'latte.prop/or-sym%
+                                                 :term or-term
+                                                 :type ty}))
+            [(list #'or-sym A B) or-term]))))))

 (defthm or-not-impl-elim
   "An alternative elimination rule for disjunction."
@@ -588,11 +600,27 @@
 (proof iff-elim-if
     :script
   (assume [H (<=> A B)]
-    (have a (==> (<=> A B)
+    have (a (==> (<=> A B)
                  (==> A B))
-          :by (and-elim-left (==> A B) (==> B A)))
+           :by (and-elim-left (==> A B) (==> B A)))
     (have b (==> A B) :by (a H))
     (qed b)))
+
+(defspecial iff-elim-if%
+  "Left (if) elimination for `<=>`, a special version of [[iff-elim-if]]."
+  [def-env ctx iff-term]
+  (let [[status ty] (ty/type-of-term def-env ctx iff-term)]
+    (if (= status :ko)
+      (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-elim-if%
+                                           :term iff-term
+                                           :from ty}))
+      (do
+        (let [[status A B] (decompose-and-type def-env ctx ty)]
+          (if (= status :ko)
+            (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-elim-if%
+                                                  :term iff-term
+                                                  :type ty}))
+            [(list #'iff-elim-if A B) iff-term]))))))

 (defthm iff-elim-only-if
   "Elimination rule for logical equivalence.
@@ -609,6 +637,22 @@
           :by (and-elim-right (==> A B) (==> B A)))
     (have b (==> B A) :by (a H))
     (qed b)))
+
+(defspecial iff-elim-only-if%
+  "Right (only if) elimination for `<=>`, a special version of [[iff-elim-only-if]]."
+  [def-env ctx iff-term]
+  (let [[status ty] (ty/type-of-term def-env ctx iff-term)]
+    (if (= status :ko)
+      (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-elim-only-if%
+                                           :term iff-term
+                                           :from ty}))
+      (do
+        (let [[status A B] (decompose-and-type def-env ctx ty)]
+          (if (= status :ko)
+            (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-elim-only-if%
+                                                  :term iff-term
+                                                  :type ty}))
+            [(list #'iff-elim-only-if A B) iff-term]))))))

 (defthm iff-sym
   "Symmetry of logical equivalence."
@@ -626,6 +670,25 @@
                  (<=> B A)) :by (iff-intro B A))
     (have d (<=> B A) :by (c a b))
     (qed d)))
+
+(defspecial iff-sym%
+  "Symmetry of `<=>`, a special version of [[iff-sym]]."
+  [def-env ctx iff-term]
+  (let [[status ty] (ty/type-of-term def-env ctx iff-term)]
+    (when (= status :ko)
+      (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-sym%
+                                           :term iff-term
+                                           :from ty})))
+    (let [[status C _] (decompose-and-type def-env ctx ty)]
+      (when (= status :ko)
+        (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-sym%
+                                              :term iff-term
+                                              :type ty})))
+      (when-not (stx/prod? C)
+        (throw (ex-info "Not a product type." {:special 'latte.prop/iff-sym%
+                                               :term C})))
+      (let [[_ [A _] B] C]
+        [(list #'iff-sym A B) iff-term]))))

 (defthm iff-trans
   "Transitivity of logical equivalence."


Fix not =

Fix not =

--- src/onyx/log/commands/common.clj
+++ src/onyx/log/commands/common.clj
@@ -69,7 +69,7 @@
 (defn start-new-lifecycle [old new diff state]
   (let [old-allocation (peer->allocated-job (:allocations old) (:id state))
         new-allocation (peer->allocated-job (:allocations new) (:id state))]
-    (if-not (not old-allocation new-allocation)
+    (if-not (= old-allocation new-allocation)
       (do (when (:lifecycle state)
             (component/stop @(:lifecycle state)))
           (let [seal-ch (chan)


Show the id in the main view

Show the id in the main view

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -25,7 +25,7 @@
     (layout/common user
      [:h1 "Productions"]
      [:table.table.table-striped
-      [:thead [:tr [:th "Title"] [:th "Type"] [:th "State"] [:th "Action"]]]
+      [:thead [:tr [:th "DAM"] [:th "Title"] [:th "Type"] [:th "State"] [:th "Action"]]]
       [:tbody
        (let [cached-state (memoize db/find-state)
              cached-production-type (memoize db/find-production-type)]
@@ -34,6 +34,7 @@
                  realized-production-type (first (cached-production-type {:id production_type}))
                  next-state (:next_state realized-state)]
              [:tr
+              [:td id]
               [:td (link-to (str "/production/" id) title)]
               [:td (:name realized-production-type)]
               [:td (:name realized-state)]


added more tests

added more tests

--- test/graph/core_test.clj
+++ test/graph/core_test.clj
@@ -133,6 +133,16 @@
   )
 )

+(deftest expand-tests
+  (testing "should work with a basic query"
+    (let [g (basicGraph)
+          result (expandWhere g ["class:1" "class:2"] {"data" "foo"})]
+      (is (= result ["class:1"]))))
+
+  (testing "should work with a single key"
+    (let [g (basicGraph)
+          result (expandWhere g ["class:1" "class:2"] {"vertexId" "class:2"})]
+      (is (= result ["class:2"])))))

 (deftest vertex-key-tests
@@ -176,3 +186,17 @@
                     (fn [item] [item (- item 1)])
                     [1 2 3])]
       (is (= result #{0 1 2 3})))))
+
+(deftest uniq-tests
+  (testing "should work with vecs of numbers"
+    (is (= (uniq [1 2 2 3]) [1 2 3])))
+
+  (testing "should work with vecs of strings"
+    (is (= (uniq ["1" "2" "2" "3"]) ["1" "2" "3"])))
+
+  (testing "should work with sets of numbers"
+    (is (= (uniq #{1 2 3}) [1 2 3])))
+
+  (testing "should work with sets of strings"
+    (is (= (uniq #{"1" "2" "3"}) ["1" "2" "3"])))
+  )


Minor tweaks.

Minor tweaks.

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -3,7 +3,8 @@
   (:use [midje.ideas.metadata :only [fact-source]]
         [midje.util.ecosystem :only [fact-namespaces]]
         [midje.ideas.reporting.string-format :only [report-strings-summary]])
-  (:require [midje.ideas.rerunning-facts :as rerun]
+  (:require midje.sweet
+            [midje.ideas.rerunning-facts :as rerun]
             [midje.clojure-test-facade :as ctf]))

@@ -26,7 +27,7 @@
   []
   ((last-fact-checked)))

-(defn check-facts
+(defn unobtrusive-check-facts
   "With no argument, checks all known facts.
    With arguments (namespaces or symbols), only runs facts
    in those namespaces. Returns true iff all facts check out."
@@ -36,14 +37,26 @@
      (rerun/compendium-contents)
      (mapcat rerun/namespace-facts namespaces))))

+(declare report-results)
+
+(defmacro ^{:private true} report-check-group [& body]
+  `(do (ctf/zero-counters)
+       ~@body
+       (report-results)))
+
+(defn check-facts [& args]
+  (report-check-group
+   (apply unobtrusive-check-facts args)))
+
 (defn forget-facts
   "After this, `check-facts` does nothing until new facts are defined."
   ([]
-     (rerun/forget-facts-in-namespace *ns*))
+     (forget-facts *ns*))
   ([& namespaces]
      (if (= namespaces [:all])
        (rerun/reset-compendium)
-       (dorun (map rerun/forget-facts-in-namespace namespaces)))))
+       (dorun (map rerun/forget-facts-in-namespace namespaces)))
+     :done))

 (defn fetch-matching-facts
   "Returns a sequence of all facts matching
@@ -84,15 +97,11 @@
   ;; Clojure 1.4 (at least) runs out of memory. Moreover,
   ;; (require ns1 ns2 ns3 ... nsN :reload-all) will reload a shared
   ;; dependency N times.
-  (dorun (map #(require % :reload) (apply fact-namespaces args))))
-
-
-
-
-;;; TODO - the workflow these imply needs testing
-
+  (report-check-group
+   (dorun (map #(require % :reload) (apply fact-namespaces args)))))

 (def forget-results ctf/zero-counters)

 (defn report-results []
   (report-strings-summary (ctf/counters)))
+


Fix prefix libspec edgecase

Fix prefix libspec edgecase

When a prefix entry appeared as the last entry if the :require form it
would print as a regular libspec

--- src/refactor_nrepl/ns/pprint.clj
+++ src/refactor_nrepl/ns/pprint.clj
@@ -36,7 +36,9 @@
     (fn [idx libspec]
       (if (= idx (dec (count libspecs)))
         (printf "%s)\n" (str/trim-newline
-                         (with-out-str (pprint libspec))))
+                         (with-out-str (if (prefix-form? libspec)
+                                         (pprint-prefix-form libspec)
+                                         (pprint libspec)))))
         (if (prefix-form? libspec)
           (pprint-prefix-form libspec)
           (pprint libspec))))


Refactor clojure test code

Refactor clojure test code

--- client_tests/clojure/clj-s3/test/java_s3_tests/test/client.clj
+++ client_tests/clojure/clj-s3/test/java_s3_tests/test/client.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) 2007-2013 Basho Technologies, Inc.  All Rights Reserved.
+;; Copyright (c) 2007-2015 Basho Technologies, Inc.  All Rights Reserved.
 ;;
 ;; This file is provided to you under the Apache License,
 ;; Version 2.0 (the "License"); you may not use this file
@@ -24,12 +24,8 @@
   (:require [clojure.tools.logging :as log])
   (:use midje.sweet))

-(def ^:internal riak-cs-host-with-protocol "http://localhost")
-(def ^:internal riak-cs-host "localhost")
-
-(defn input-stream-from-string
-  [s]
-  (java.io.ByteArrayInputStream. (.getBytes s "UTF-8")))
+(def ^:internal riak-cs-host "127.0.0.1")
+(def ^:internal riak-cs-host-with-protocol (str "http://" riak-cs-host))

 (defn get-riak-cs-port-str
   "Try to get a TCP port number from the OS environment"
@@ -58,25 +54,31 @@
    :proxy {:host riak-cs-host
            :port (get-riak-cs-port)}})

+(defn random-user
+  []
+  (user-creation/create-random-user riak-cs-host-with-protocol (get-riak-cs-port)))
+
+(defmacro with-random-user
+  "Execute `body` in implicit do with a random-user bound to `var-name`"
+  [var-name & body]
+  `(let [~var-name (random-user)]
+     (do ~@body)))
+
 (defn random-cred
   []
-  (let [new-cred (user-creation/create-random-user
-                   riak-cs-host-with-protocol
-                   (get-riak-cs-port))]
-    (user-to-cred new-cred)))
+  (user-to-cred (random-user)))

 (defmacro with-random-cred
-  "Execute `form` with a random-cred
-  bound to `var-name`"
-  [var-name form]
+  "Execute `body` in implicit do with a random-cred bound to `var-name`"
+  [var-name & body]
   `(let [~var-name (random-cred)]
-     ~form))
+     (do ~@body)))

 (defn random-string []
   (str (java.util.UUID/randomUUID)))

 (defn write-file [filename content]
-  (with-open [w (clojure.java.io/writer  filename :append false)]
+  (with-open [w (clojure.java.io/writer filename :append false)]
     (.write w content)))

 (defn etag-suffix [etag]
@@ -99,32 +101,30 @@
       => [])

 (let [bucket-name (random-string)]
-  (fact "creating a bucket should list
-        one bucket in list buckets"
-        (with-random-cred c
-          (do (s3/create-bucket c bucket-name)
-              ((comp :name first) (s3/list-buckets c))))
-        => bucket-name))
+  (fact "creating a bucket should list one bucket in list buckets"
+        (with-random-cred c
+          (s3/create-bucket c bucket-name)
+          (map :name (s3/list-buckets c))
+        => [bucket-name])))

 (let [bucket-name (random-string)
       object-name (random-string)]
   (fact "simple put works"
         (with-random-cred cred
-          (do (s3/create-bucket cred bucket-name)
-              (s3/put-object cred bucket-name object-name
-                             "contents")))
+          (s3/create-bucket cred bucket-name)
+          (s3/put-object cred bucket-name object-name
+                         "contents"))
         => truthy))

 (let [bucket-name (random-string)
       object-name (random-string)
       value "this is the value!"]
   (fact "the value received during GET is the same
-        as the object that was PUT"
-        (with-random-cred c
-          (do (s3/create-bucket c bucket-name)
-              (s3/put-object c bucket-name object-name
-                             value)
-              ((comp slurp :content) (s3/get-object c bucket-name object-name))))
+         as the object that was PUT"
+        (with-random-cred c
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value)
+          ((comp slurp :content) (s3/get-object c bucket-name object-name)))
         => value))

 (let [bucket-name (random-string)
@@ -132,33 +132,31 @@
       value "this is the value!"
       as-bytes (.getBytes value "UTF-8")
       md5-sum (md5-string as-bytes)]
-  (fact "check that the etag of the response
-        is the same as the md5 of the original
-        object"
-        (with-random-cred c
-          (do (s3/create-bucket c bucket-name)
-            (s3/put-object c bucket-name object-name
-                           value)
-            ((comp :etag :metadata)
-               (s3/get-object
-                 c bucket-name object-name))))
+  (fact "check that the etag of the response is the same as the md5
+         of the original object"
+        (with-random-cred c
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value)
+          ((comp :etag :metadata)
+           (s3/get-object
+            c bucket-name object-name)))
         => md5-sum))

 (let [bucket-name (random-string)
       object-name (random-string)
-      value (str "aaaaaaaaaa" "bbbbbbbbbb")
+      value "aaaaaaaaaabbbbbbbbbb"
       file-name "./clj-mp-test.txt"]
   (fact "multipart upload works"
         (with-random-cred c
-          (do
-            (s3/create-bucket c bucket-name)
-            (write-file file-name value)
-            (upload-file c bucket-name object-name file-name 10)
-            (let [fetched-object (s3/get-object
-                                  c bucket-name object-name)]
-              [((comp slurp :content) fetched-object)
-               ((comp etag-suffix :etag :metadata) fetched-object)])))
-        => [value, "-2"]))
+          (s3/create-bucket c bucket-name)
+          (write-file file-name value)
+          (upload-file c bucket-name object-name file-name 10)
+          (let [fetched-object (s3/get-object
+                                c bucket-name object-name)]
+            ((comp slurp :content) fetched-object)
+            => value
+            ((comp etag-suffix :etag :metadata) fetched-object)
+            => "-2"))))

 (let [bucket-name (random-string)
       object-name (random-string)
@@ -166,10 +164,9 @@
       wrong-md5 "2945d7de2f70de5b8c0cb3fbcba4fe92"]
   (fact "Bad content md5 throws an exception"
         (with-random-cred c
-          (do
-            (s3/create-bucket c bucket-name)
-            (s3/put-object c bucket-name object-name value
-                           {:content-md5 wrong-md5})))
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value
+                         {:content-md5 wrong-md5}))
         => (throws AmazonS3Exception)))

 (def bad-canonical-id
@@ -181,11 +178,9 @@
   (fact "Nonexistent canonical-id grant header returns HTTP 400 on
         a put object request (not just an ACL subresource request)"
         (with-random-cred c
-          (do
-            ;; create a bucket
-            (s3/create-bucket c bucket-name)
-            (s3/put-object c bucket-name object-name value-string {}
-                           (s3/grant {:id bad-canonical-id} :full-control))))
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value-string {}
+                         (s3/grant {:id bad-canonical-id} :full-control)))
         => (throws AmazonS3Exception)))

 (let [bucket-name (random-string)
@@ -195,15 +190,11 @@
   (fact "Creating an object with an ACL returns the same ACL when you read
         the ACL"
         (with-random-cred c
-          (do
-            ;; create a bucket
-            (s3/create-bucket c bucket-name)
-            (s3/put-object c bucket-name object-name value-string {}
-                           (s3/grant :all-users :read))
-            (contains?
-             (:grants (s3/get-object-acl c bucket-name object-name))
-             public-read-grant)))
-        => truthy))
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value-string {}
+                         (s3/grant :all-users :read))
+          (:grants (s3/get-object-acl c bucket-name object-name)))
+        => (contains (just public-read-grant))))

 (let [bucket-name (random-string)
       object-name (random-string)
@@ -212,68 +203,47 @@
   (fact "Creating an object with an ACL returns the same ACL when you read
         the ACL"
         (with-random-cred c
-          (do
-            ;; create a bucket
+          (s3/create-bucket c bucket-name)
+          (s3/put-object c bucket-name object-name value-string {}
+                         (s3/grant :all-users :read))
+          (:grants (s3/get-object-acl c bucket-name object-name)))
+        => (contains (just public-read-grant))))
+
+(let [bucket-name (random-string)
+      object-name (random-string)
+      value-string "this is the real value"]
+  (with-random-cred c
+    (with-random-user u2
+      (fact "Creating an object with an (non-canned) ACL returns the same ACL
+             when you read the ACL"
             (s3/create-bucket c bucket-name)
             (s3/put-object c bucket-name object-name value-string {}
-                           (s3/grant :all-users :read))
-            (contains?
-             (:grants (s3/get-object-acl c bucket-name object-name))
-             public-read-grant)))
-        => truthy))
-
-(let [bucket-name (random-string)
-      object-name (random-string)
-      value-string "this is the real value"]
-  (fact "Creating an object with an (non-canned) ACL returns the same ACL
-        when you read the ACL"
-        (with-random-cred c
-          (do
-            (s3/create-bucket c bucket-name)
-            (let [user-two (user-creation/create-random-user
-                            riak-cs-host-with-protocol
-                            (get-riak-cs-port))
-                  user-two-id (:id user-two)
-                  user-two-name (:display_name user-two)
-                  acl-grant {:grantee {:id user-two-id, :display-name user-two-name},
-                             :permission :read}]
-              (s3/put-object c bucket-name object-name value-string {}
-                             (s3/grant {:id user-two-id} :read))
-              (contains?
-                (:grants (s3/get-object-acl c bucket-name object-name))
-                acl-grant))))
-        => truthy))
-
-(let [bucket-name (random-string)
-      object-name (random-string)
-      public-read-grant {:grantee :all-users, :permission :read}]
+                           (s3/grant {:id (:id u2)} :read))
+            (:grants (s3/get-object-acl c bucket-name object-name))
+            => (contains (just {:grantee {:id (:id u2),
+                                          :display-name (:display_name u2)},
+                                :permission :read}))))))
+
+(let [bucket-name (random-string)
+      object-name (random-string)]
   (fact "Creating a bucket with an ACL returns the same ACL when you read
         the ACL"
         (with-random-cred c
           (do
             (s3/create-bucket c bucket-name {}
                               (s3/grant :all-users :read))
-            (contains?
-             (:grants (s3/get-bucket-acl c bucket-name))
-             public-read-grant)))
-        => truthy))
+            (:grants (s3/get-bucket-acl c bucket-name))))
+        => (contains (just {:grantee :all-users, :permission :read}))))

 (let [bucket-name (random-string)
       object-name (random-string)]
-  (fact "Creating a bucket with an (non-canned) ACL returns the same ACL
-        when you read the ACL"
-        (with-random-cred c
-          (do
-            (let [user-two (user-creation/create-random-user
-                            riak-cs-host-with-protocol
-                            (get-riak-cs-port))
-                  user-two-id (:id user-two)
-                  user-two-name (:display_name user-two)
-                  acl-grant {:grantee {:id user-two-id, :display-name user-two-name},
-                             :permission :write}]
-              (s3/create-bucket c bucket-name {}
-                                (s3/grant {:id user-two-id} :write))
-              (contains?
+  (with-random-cred c
+    (with-random-user u2
+        (fact "Creating a bucket with an (non-canned) ACL returns the same ACL
+               when you read the ACL"
+               (s3/create-bucket c bucket-name {}
+                                 (s3/grant {:id (:id u2)} :write))
                (:grants (s3/get-bucket-acl c bucket-name))
-               acl-grant))))
-        => truthy))
+               => (contains (just {:grantee {:id (:id u2),
+                                             :display-name (:display_name u2)},
+                                   :permission :write}))))))


avoid printing stack trace when old test index does not exist

--- test/wb_es/core_test.clj
+++ test/wb_es/core_test.clj
@@ -36,12 +36,12 @@
   (do
     (let [index-url (format "%s/%s" es-base-url index-name)]
       (do
-        (if (http/get index-url)
-          (try
-            (http/delete index-url)
-            (catch clojure.lang.ExceptionInfo e
-              (prn "failed to delete index.")
-              (prn e))))
+        (try
+          (http/delete index-url)
+          (catch clojure.lang.ExceptionInfo e
+            (if-not (= (:status (ex-data e))
+                       404)
+              (prn "failed to delete index." (ex-data e)))))
         (http/put index-url {:headers {:content-type "application/json"}
                              :body (->> (assoc-in mappings/index-settings [:settings :number_of_shards] 1)
                                         (json/generate-string))})


Don't throw on exit with suppressed exit

--- src/pallet/cli.clj
+++ src/pallet/cli.clj
@@ -53,7 +53,7 @@
     (do
       (shutdown-agents)
       (System/exit exit-code))
-    (throw (ex-info "suppressed exit" {:exit-code exit-code}))))
+    exit-code))

 (def pallet-switches
   [["-P" "--service" "Service key to use (use add-service to create a service"]


Update to fix compilation

Update to fix compilation

--- src/photon/api.clj
+++ src/photon/api.clj
@@ -28,7 +28,7 @@
   (let [res (first (filter #(= (name (:projection-name %)) projection-name)
                            (map deref (vals @streams/queries))))]
     (log/info "Result:" (pr-str res))
-    (log/info "Result:" (pr-str (muon-clojure.common/dekeywordize res)))
+    (log/info "Result:" (pr-str (muon-clojure.utils/dekeywordize res)))
     res))

 (defn proper-map [m]


fix observation bug

fix observation bug

--- src/qttt/game.cljs
+++ src/qttt/game.cljs
@@ -145,9 +145,9 @@
   Given an observation, return a set of observations implied based
   on the accepted cell's entanglements."
   [game [accepted-cell accepted-subcell]]
-  (map :pair
-    (vals (dissoc (get-in game [:board accepted-cell :entanglements])
-            accepted-subcell))))
+  (set (map :pair
+         (vals (dissoc (get-in game [:board accepted-cell :entanglements])
+                 accepted-subcell)))))

 (defn observe-all
   "Given a set of observations, recursively calculate *all* observations inferred from entangled cells"


removed broken test function

removed broken test function

--- src/ttfe/core.cljs
+++ src/ttfe/core.cljs
@@ -104,17 +104,6 @@
           (move grid :top)
           (move grid :bottom))))

-;; Pure Grid test funcions.
-
-(defn random-block
-  [grid]
-  (loop [g grid
-         i 0]
-        (let [moved (move g (rand-nth [:left :right :top :bottom]))]
-          (if (or (not moved) (= i 500))
-            g
-            (recur moved (inc i))))))
-
 ;; Pure app state functions.

 (defn app-state-reset


Fix bug when statting blobs.

Fix bug when statting blobs.

--- src/vault/blob.clj
+++ src/vault/blob.clj
@@ -123,9 +123,10 @@
    (enumerate store nil))
   ([store opts]
    (enumerate store opts))
-  ([store first-opt & opts]
-   (->> (cons first-opt opts)
+  ([store opt-key opt-val & opts]
+   (->> opts
         (partition 2)
+        (cons [opt-key opt-val])
         (into {})
         (enumerate store))))


updated type hints from e.g. #^Document to ^Document

--- src/vix/lucene.clj
+++ src/vix/lucene.clj
@@ -37,7 +37,7 @@
            [org.jsoup Jsoup]
            [java.io File]))

-(defn #^StandardAnalyzer create-analyzer []
+(defn ^StandardAnalyzer create-analyzer []
   "Creates a StandardAnalyzer that tokenizes fulltext fields."
   (StandardAnalyzer. (. Version LUCENE_35)))

@@ -50,7 +50,7 @@
 (def directory (create-directory config/lucene-index-path))
 (def analyzer (create-analyzer))

-(defn #^IndexReader create-index-reader [#^Directory directory]
+(defn ^IndexReader create-index-reader [^Directory directory]
   "Creates IndexReader for the specified directory, but returns nil if
    the provided directory exists but doesn't contain a valid index."
   (try
@@ -58,7 +58,7 @@
     (catch IndexNotFoundException e
       nil)))

-(defn #^Field create-field
+(defn ^Field create-field
   "Creates a new Lucene Field object.
   The Field will be stored if a :stored keyword is passed. The index
   value has two options: :analyzed or :indexed-not-analyzed
@@ -76,7 +76,7 @@
                    (Field$Index/NO))]
        (Field. field-name (str value) store? index?))))

-(defn #^NumericField create-numeric-field
+(defn ^NumericField create-numeric-field
   "Creates a Lucene NumericField object set to the provided value or
    -1 if this value isn't either a Double, Float, Integer or Long
    object.
@@ -97,7 +97,7 @@
      (= (class value) java.lang.Long) (.setLongValue field value)
      :default (.setIntValue field -1))))

-(defn #^String distill-plaintext
+(defn ^String distill-plaintext
   "Distills the text value from an HTML string, followed by the
    values of any alt and title attributes of <img/> tags separated
    by newlines."
@@ -112,7 +112,7 @@
                  (interleave (map #(.attr % "alt") img-tags)
                              (map #(.attr % "title") img-tags)))))))

-(defn #^Document create-document [vix-doc]
+(defn ^Document create-document [vix-doc]
   "Creates a Lucene Document object representing the Vix document that
    is passed as a map (e.g. directly from the database).."
   (let [{:keys [feed
@@ -127,7 +127,7 @@
                 description]}
         vix-doc]

-    (doto #^Document (Document.)
+    (doto ^Document (Document.)
           ;; create a fulltext field with all the values to search on
           ;; mashed together in a single value. This field is not stored.
           (.add (create-field "fulltext"
@@ -168,7 +168,7 @@
                                       :stored
                                       :indexed)))))

-(defn #^IndexWriter create-index-writer [analyzer directory mode]
+(defn ^IndexWriter create-index-writer [analyzer directory mode]
   "Creates an IndexWriter with the provided analyzer and directory.
    The mode has three options: :create, :append or :create-or-append."
   (let [config (IndexWriterConfig. (Version/LUCENE_35) analyzer)]
@@ -222,7 +222,7 @@
                      (create-document document)
                      (create-analyzer))))

-(defn #^NumericRangeQuery create-date-range-query
+(defn ^NumericRangeQuery create-date-range-query
   [field-name start-date-rfc3339 end-date-rfc3339]
   "Creates a NumericRangeQuery for field-name using start and end date
    string arguments."
@@ -233,7 +233,7 @@
                (>= max min))
       (NumericRangeQuery/newLongRange field-name min max true true))))

-(defn #^QueryWrapperFilter create-filter [filters]
+(defn ^QueryWrapperFilter create-filter [filters]
   "Creates a Lucene BooleanQuery wrapped in a QueryWrapperFilter with one
    or more filter queries (if zero this function returns nil).

@@ -300,7 +300,7 @@
     (when (pos? (alength (.getClauses bq)))
       (QueryWrapperFilter. bq))))

-(defn #^Document get-doc [reader doc-id]
+(defn ^Document get-doc [reader doc-id]
   "Reads the document with the provided doc-id from the index."
   (.document reader doc-id))


fixed bug in lucene search function

fixed bug in lucene search function

--- src/vix/lucene.clj
+++ src/vix/lucene.clj
@@ -116,11 +116,13 @@
   (let [{:keys [feed
                 slug
                 title
+                subtitle
                 draft
                 language
                 published
                 updated
-                content]}
+                content
+                description]}
         vix-doc]

     (doto #^Document (Document.)
@@ -130,8 +132,13 @@
                               (apply str
                                      (interpose "\n"
                                                 [title
-                                                 (distill-plaintext
-                                                  content)]))
+                                                 subtitle
+                                                 (when content
+                                                   (distill-plaintext
+                                                    content))
+                                                 (when description
+                                                   (distill-plaintext
+                                                    description))]))
                               :analyzed))

           (.add (create-field "feed" feed :indexed-not-analyzed :stored))
@@ -332,34 +339,38 @@
   ([query filter limit reader analyzer]
      (search query filter limit nil nil reader analyzer))
   ([query filter limit after-doc-id after-score reader analyzer]
-     (let [searcher (IndexSearcher. reader)
-           parser (QueryParser. (Version/LUCENE_35) "fulltext" analyzer)
-           q (.parse parser query)
-           top-docs (if (nil? after-doc-id)
-                      (if (nil? filter)
-                        (.search searcher q limit)
-                        (.search searcher q filter limit))
-                      (if (nil? filter)
-                        (.searchAfter searcher
-                                      (ScoreDoc. after-doc-id after-score)
-                                      q
-                                      limit)
-                        (.searchAfter searcher
-                                      (ScoreDoc. after-doc-id after-score)
-                                      q
-                                      filter
-                                      limit)))]
-
-       (. searcher close)
+     (if (and (not-empty query) (not-any? #(= (first query) %) #{\*\?}))
+       (let [searcher (IndexSearcher. reader)
+             parser (QueryParser. (Version/LUCENE_35) "fulltext" analyzer)
+             q (.parse parser query)
+             top-docs (if (nil? after-doc-id)
+                        (if (nil? filter)
+                          (.search searcher q limit)
+                          (.search searcher q filter limit))
+                        (if (nil? filter)
+                          (.searchAfter searcher
+                                        (ScoreDoc. after-doc-id after-score)
+                                        q
+                                        limit)
+                          (.searchAfter searcher
+                                        (ScoreDoc. after-doc-id after-score)
+                                        q
+                                        filter
+                                        limit)))]
+
+         (. searcher close)

-       {:total-hits (.totalHits top-docs)
-        :docs (map #(assoc (document-to-map (second %))
-                      :index {:doc-id (.doc (first %))
-                              :score (.score (first %))})
-                   (partition 2
-                              (interleave
-                               (.scoreDocs top-docs)
-                               (get-docs reader (.scoreDocs top-docs)))))})))
+         {:total-hits (.totalHits top-docs)
+          :docs (map #(assoc (document-to-map (second %))
+                        :index {:doc-id (.doc (first %))
+                                :score (.score (first %))})
+                     (partition 2
+                                (interleave
+                                 (.scoreDocs top-docs)
+                                 (get-docs reader
+                                           (.scoreDocs top-docs)))))})
+       {:total-hits 0
+        :docs nil})))

 (defn search-jump-to-page
   "This function performs a search and drops results from the unwanted


Track jira :add-credentials-clicked

Track jira :add-credentials-clicked

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1685,33 +1685,42 @@
            nil)
          (when (config/jira-connect-enabled?)
            [:p "There are 2 options for setting up JIRA with CircleCI: Atlassian Connect or JIRA Basic Authentication. Choose one of the options below to continue."])
-         (element
-          :column-group
-          (html
-           [:div
-            (when (config/jira-connect-enabled?)
+         (letfn [(track-event [auth-type]
+                   ((om/get-shared owner :track-event)
+                    {:event-type :add-credentials-clicked
+                     :properties {:component "jira-integration"
+                                  :auth-type auth-type}}))]
+           (element
+            :column-group
+            (html
+             [:div
+              (when (config/jira-connect-enabled?)
+                [:div.column
+                 [:.title "Atlassian Connect for CircleCI"]
+                 [:p "If you are an Atlassian administrator you can get a token by following the instructions "
+                  [:a
+                   {:href "https://marketplace.atlassian.com/plugins/circleci.jira/cloud/overview"
+                    :target "_blank"}
+                   "here"]
+                  "."]
+                 (button/button {:kind :primary
+                                 :on-click (fn [_]
+                                             (om/set-state! owner :modal :connect)
+                                             (track-event "connect"))}
+                                "Add Token")])
               [:div.column
-               [:.title "Atlassian Connect for CircleCI"]
-               [:p "If you are an Atlassian administrator you can get a token by following the instructions "
-                [:a
-                 {:href "https://marketplace.atlassian.com/plugins/circleci.jira/cloud/overview"
-                  :target "_blank"}
-                 "here"]
-                "."]
+               (when (config/jira-connect-enabled?)
+                 [:.title "JIRA Basic Authentication"])
+               [:p (str
+                    (if (config/jira-connect-enabled?)
+                      "If you are not an Atlassian administrator you can s"
+                      "S")
+                    "tore your JIRA username, password, and JIRA base hostname to connect JIRA and CircleCI.")]
                (button/button {:kind :primary
-                               :on-click #(om/set-state! owner :modal :connect)}
-                              "Add Token")])
-            [:div.column
-             (when (config/jira-connect-enabled?)
-               [:.title "JIRA Basic Authentication"])
-             [:p (str
-                  (if (config/jira-connect-enabled?)
-                    "If you are not an Atlassian administrator you can s"
-                    "S")
-                  "tore your JIRA username, password, and JIRA base hostname to connect JIRA and CircleCI.")]
-             (button/button {:kind :primary
-                             :on-click #(om/set-state! owner :modal :basic)}
-                            "Add JIRA Credentials")]]))])))))
+                               :on-click (fn [_]
+                                           (om/set-state! owner :modal :basic)
+                                           (track-event "basic"))}
+                              "Add Credentials")]])))])))))

 (defmulti jira-installed
   "View to display when jira credentials are installed on the project."


Recreate db.

Recreate db.

--- src/twitter_collector/client.clj
+++ src/twitter_collector/client.clj
@@ -67,6 +67,7 @@
                                              ;; not tested yet
                                              :reset-fn (fn [old-conn] (prn "Resetting Datomic!")
                                                          (d/delete-database db-uri)
+                                                         (d/create-database db-uri)
                                                          (def conn (d/connect db-uri))
                                                          @(d/transact conn (read-string (slurp "schema.edn")))
                                                          conn)))


Add metadata to exceptions and warnings

Add metadata to exceptions and warnings

--- src/adzerk/boot_cljs/impl.clj
+++ src/adzerk/boot_cljs/impl.clj
@@ -44,7 +44,11 @@
             msg  (some-> e (.getCause) (.getMessage))
             path (util/find-relative-path dirs file)
             exs  (format "ERROR: %s on file %s, line %d, column %d\n" msg path line column)]
-        (swap! report-atom assoc :exception exs)
+        (swap! report-atom assoc :exception {:message exs
+                                             :type type
+                                             :file file
+                                             :line line
+                                             :column column})
         (butil/fail exs))

       :default (throw e))))
@@ -61,9 +65,12 @@
         messages (atom {:exception nil
                         :warnings []})
         handler (fn [warning-type env extra]
-                  (let [s (ana/error-message warning-type extra)]
-                    (when (warning-enabled? warning-type)
-                      (swap! messages update :warnings conj (ana/message env s)))))]
+                  (when (warning-enabled? warning-type)
+                    (let [s (ana/error-message warning-type extra)]
+                      (swap! messages update :warnings conj {:message s
+                                                             :file ana/*cljs-file*
+                                                             :line (:line env)
+                                                             :type warning-type}))))]
     (try
       (build
         (apply inputs input-path directories)


Restore proper ordering of overlay-handled?

--- src/afterglow/controllers.clj
+++ src/afterglow/controllers.clj
@@ -418,7 +418,11 @@
   this message; if so, send it, and see if the overlay consumes it.
   Returns truthy if an overlay consumed the message, and it should not
   be given to anyone else. `state` must be a value created
-  by [[create-overlay-state]] and tracked by the controller."
+  by [[create-overlay-state]] and tracked by the controller.
+
+  More recent (and higher priority) overlays get the first chance to
+  decide if they want to consume the message, so the overlay list is
+  traversed in reverse order."
   [state message]
   (case (:command message)
     (:note-on :note-off :poly-pressure)
@@ -431,7 +435,7 @@
                 (when (= result :done)
                   (swap! state update-in [:overlays] dissoc k))
                 result)))
-          (seq (:overlays @state)))
+          (rseq (:overlays @state)))

     :control-change
     (some (fn [[k overlay]]


fix spacing

fix spacing

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -215,7 +215,6 @@

    "echar" {:synsem {:cat :verb
                      :sem {:pred :throw-out}}}
-
    "el"
    (unify determiner
           {:synsem {:cat :det
@@ -243,7 +242,6 @@
                          :gender :masc
                          :pred :lui}
                    :subcat '()}}]
-
    "ella"
    {:synsem {:cat cat-of-pronoun
              :pronoun true
@@ -251,11 +249,9 @@
              :agr {:person :3rd
                    :gender :fem
                    :number :sing}
-             :sem {:human true
-                   :gender :fem
+             :sem {:gender :fem
                    :pred :lei}
              :subcat '()}}
-
    "ellos"
    {:synsem {:cat cat-of-pronoun
              :pronoun true
@@ -263,11 +259,9 @@
              :agr {:person :3rd
                    :gender :masc
                    :number :plur}
-             :sem {:human true
-                   :gender :masc
+             :sem {:gender :masc
                    :pred :loro}
              :subcat '()}}
-
    "ellas"
    {:synsem {:cat cat-of-pronoun
              :pronoun true
@@ -275,8 +269,7 @@
              :agr {:person :3rd
                    :gender :fem
                    :number :plur}
-             :sem {:human true
-                   :gender :fem
+             :sem {:gender :fem
                    :pred :loro}
              :subcat '()}}

@@ -287,7 +280,6 @@
    "encender" {:espanol {:boot-stem "enciend"}
              :synsem {:cat :verb
                       :sem {:pred :light}}}
-
    "enojarse"
    (let [subject-semantics (ref {:human true})
          subject-agr (ref :top)]


Remove some logging stuff

Remove some logging stuff

--- src/cider_ci/utils/system.clj
+++ src/cider_ci/utils/system.clj
@@ -18,12 +18,15 @@
     [org.apache.commons.lang3 SystemUtils]
     ))

+
+;### helpers ###################################################################
+
+
 (defn create-watchdog
   ([]
    (create-watchdog (ExecuteWatchdog/INFINITE_TIMEOUT)))
   ([timeout-ms]
    (ExecuteWatchdog. timeout-ms )))
-

 (defn normalized-timeout-ms [opts]
   (let [timeout (or (:timeout opts)
@@ -34,6 +37,9 @@
                              (* 1000.0))
       (integer? timeout) (* timeout 1.0)
       :else (* 10 1000.0))))
+
+
+;### OLD #######################################################################

 (defn exec
   ([command]
@@ -59,6 +65,7 @@
          (throw (ex-info (str "Execution `"
                               (clojure.string/join " " command)
                               "` expired.") opts)))))))
+
 (defn exec-with-success-or-throw [& args]
    (logging/warn "exec-with-success-or-throw is deprecated, use exec! or async-exec")
   (let [res (apply exec args)]
@@ -114,8 +121,6 @@
   ([command opts]
    (let [wrapped-exec (async-exec command opts)
          realized-exec (-> wrapped-exec deref :exec deref)]
-     (logging/warn 'wrapped-exec wrapped-exec)
-     (logging/warn 'realized-exec realized-exec)
      (when-let [ex (-> wrapped-exec deref :exception)] (throw ex))
      (when-not (= 0 (:exit realized-exec))
        (throw  (ex-info (str "Execution `"
@@ -124,16 +129,6 @@
                         @wrapped-exec)))
      realized-exec)))

-;(exec! ["exit" "1"])
-
-;(exec! ["sleep" "10"] {:timeout "3 Seconds"})
-
-;(exec! ["echo" "Hello World!"])
-
-
-;(def ^:dynamic *P* (async-exec ["sleep" "50"] {:timeout "3 Seconds"}))
-
-

 ;### Debug #####################################################################
 ;(debug/debug-ns *ns*)


Increase timeout for publishing to 30s

Increase timeout for publishing to 30s

--- src/clj_applenewsapi/core.clj
+++ src/clj_applenewsapi/core.clj
@@ -9,7 +9,7 @@
    ; :debug true
    :throw-exceptions false
    :accept :json
-   :socket-timeout 10000
+   :socket-timeout 30000
    :conn-timeout 10000
    :headers {}})


Functions find-word-like-this and find-words-like-this

--- src/clj_mrazik/dictionary.clj
+++ src/clj_mrazik/dictionary.clj
@@ -89,13 +89,29 @@

 (defn find-word
     [word]
-    (let [words (db-interface/select-words word)]
+    (let [words (db-interface/select-words word false)]
         (clojure.pprint/pprint words)
         (for [w words]
             (condp = (:use w)
-                0 (correct-forms w)
+                0 (correct-forms w)
                 1 (incorrect-forms w)
                 2 (preferred-forms w)))))
+
+(defn find-word-like-this
+    [word]
+    (let [words (db-interface/select-words word true)]
+        (clojure.pprint/pprint words)
+        (for [w words]
+            (condp = (:use w)
+                0 (correct-forms w)
+                1 (incorrect-forms w)
+                2 (preferred-forms w)))))
+
+(defn find-words-like-this
+    [word]
+    (let [words (db-interface/select-words word true)]
+        (str "Found " (count words) " entries: "
+             (clojure.string/join ", " (map #(:term %) words)))))

 (defn term-count
     []
@@ -103,6 +119,10 @@

 (defn word-exist?
     [word]
-    (> (db-interface/select-word-count word)
+    (> (db-interface/select-word-count word false)
        0))

+(defn words-like-this
+    [word]
+    (db-interface/select-word-count word true))
+


Add line functionalityˆˆ

Add line functionalityˆˆ

--- src/clj_simple_chart/core.clj
+++ src/clj_simple_chart/core.clj
@@ -241,12 +241,15 @@
   (str "M"
        (string/join " L" points)))

+(defn line
+  ([points]
+   (line {:fill "none" :stroke "#000" :stroke-width 1} points))
+  ([props points]
+   [:path (assoc props :d (path (map (fn [[x y]] (str x "," y)) points)))]))
+
 (defn dotted-line [{fill :fill stroke :stroke} points]
   [:g
-   [:path {:d (path (map (fn [[x y]] (str x "," y)) points))
-           :fill "none"
-           :stroke stroke
-           :stroke-width 2}]
+   (line {:fill "none" :stroke stroke :stroke-width 2} points)
    (map (fn [[x y]]
           [:circle
            {:fill fill


Fix large flint drops

Fix large flint drops

--- src/cljc/robinson/update.cljc
+++ src/cljc/robinson/update.cljc
@@ -1226,13 +1226,10 @@
                                  (if (or harvestable
                                          ;; TODO: make large flint stone have a higher chance of dropping away
                                          ;; from the player's starting-pos.
-                                         (= 0 (rr/uniform-int 10000)))
-                                   [(rr/rand-nth [(ig/gen-item :rock) (ig/gen-item :large-flint)])]
-                                   []))
-                               (concat
-                                 (if (or harvestable
                                          (= 0 (rr/uniform-int 1000)))
-                                   [(rr/rand-nth [(ig/gen-item :rock) (ig/gen-item :flint)])]
+                                   [(rr/rand-nth [(ig/gen-item :rock) (if (= 0 (rr/uniform-int 100))
+                                                                        (ig/gen-item :large-flint)
+                                                                        (ig/gen-item :flint))])]
                                    [])))
                           :else [])
                         [])]


Decrease A* search space drastically

Decrease A* search space drastically

--- src/cljc/robinson/update.cljc
+++ src/cljc/robinson/update.cljc
@@ -2442,7 +2442,7 @@
           player-pos-vec         [(-> player :pos :x) (-> player :pos :y)]
           width                  (get-in state [:world :width])
           height                 (get-in state [:world :height])
-          bounds                 [(- width) (- height) width height]
+          bounds                 (vec (mapcat (fn [t] (map (partial + t) npc-pos-vec)) [(- threshold) threshold]))
           _ (log/info "pathfinding bounds" bounds)
           get-type               (memoize (fn [x y] (do
                                                       ;(log/debug "traversable?" x y "type" (get-in place [y x :type]))


[datasets/mnist] s3 > yann. (#116)

[datasets/mnist] s3 > yann. (#116)

The site we were getting these from has been flaky. I put them on our s3 as public, hopefully that will be more reliable.

--- src/cortex/datasets/mnist.clj
+++ src/cortex/datasets/mnist.clj
@@ -37,8 +37,8 @@

 (defn download-dataset-item [name]
-  (stream/download-gzip-stream "mnist" name
-                               (str "http://yann.lecun.com/exdb/mnist/" name ".gz")))
+  (stream/download-gzip-stream
+   "mnist" name (str "https://s3-us-west-2.amazonaws.com/thinktopic.datasets/mnist/" name ".gz")))

 (defn ^DataInputStream get-data-stream [name]


Add fn get-issue

Add fn get-issue

--- src/discuss/utils/common.cljs
+++ src/discuss/utils/common.cljs
@@ -36,6 +36,13 @@
          :sidebar    {:show? true}
          }))

+(defn str->int
+  "Convert String to Integer."
+  [s]
+  (let [converted (js/parseInt s)]
+    (when-not (js/isNaN converted)
+      converted)))
+
 ;; Get
 (defn get-cursor
   "Return a cursor to the corresponding key in the app-state."
@@ -56,6 +63,11 @@
   "Returns list of dictionaries with all available issues."
   []
   (get-in @app-state [:issues :all]))
+
+(defn get-issue
+  "Return specific issue, matching by id."
+  [issue]
+  (first (filter #(= (str->int (:uid %)) issue) (get-issues))))

 (defn get-bubbles
   "Return message bubbles from DBAS."
@@ -200,11 +212,6 @@
   [sub st]
   (not= (.indexOf st sub) -1))

-(defn str->int
-  "Convert String to Integer."
-  [s]
-  (js/parseInt s))
-

 ;;;; CSS modifications
 (defn toggle-class


Use a different vendor extention key for identifying Rook endpoint

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -307,12 +307,11 @@
         params-key            (concat paths-key ["parameters"])]
     (as-> swagger-object %
           (assoc-in % paths-key
-                    (remove-nil-vals {:description    description
-                                      :summary        summary
+                    (remove-nil-vals {:description     description
+                                      :summary         summary
                                       ;; This is required inside a Operation object:
-                                      :responses      {}
-                                      ;; This aligns very nicely with Rook:
-                                      :x-operation-id (:function endpoint-meta)}))
+                                      :responses       {}
+                                      :x-rook-endpoint (:function endpoint-meta)}))
           (path-params-injector swagger-options % routing-entry params-key)
           (query-params-injector swagger-options % routing-entry params-key)
           (body-params-injector swagger-options % routing-entry params-key)


clojure: cider 0.9.1 version bump

clojure: cider 0.9.1 version bump

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1 +1 @@
-{:user {:plugins [[cider/cider-nrepl "0.8.2"]]}}
+{:user {:plugins [[cider/cider-nrepl "0.9.1"]]}}


RS+CM #105 - Fix null-pointer in admin-removal integration test

--- test/objective8/integration/front_end/admin_removals.clj
+++ test/objective8/integration/front_end/admin_removals.clj
@@ -75,7 +75,8 @@
        (fact "admin removals can be retrieved"
              (against-background
                (http-api/get-admin-removals) => {:status ::http-api/success
-                                                 :result [{:removal-uri OBJECTIVE_URI}]})
+                                                 :result [{:removal-uri OBJECTIVE_URI
+                                                           :_created_at "2015-03-24T17:06:37.714Z"}]})
              (let [{response :response} (-> (ih/test-context)
                                             (p/request (utils/path-for :fe/admin-activity)))]
                (:status response) => 200


removing utils namespace because funimage.imagej is for library-mode/standalone only now

--- src/plugins/Scripts/Funimage/SpatialAnalysis/local_area_coverage.clj
+++ src/plugins/Scripts/Funimage/SpatialAnalysis/local_area_coverage.clj
@@ -2,7 +2,7 @@
 ; @Integer(label="Radius",description="Coverage within a ball of this radius will be analyzed.",value=25) Funimage.SpatialAnalysis.local-area-coverage/density-radius
 ; @OUTPUT ImagePlus Funimage.SpatialAnalysis.local-area-coverage/density-imp
 (ns Funimage.SpatialAnalysis.local-area-coverage
-  (:use [funimage img imp project conversion utils]
+  (:use [funimage img imp project conversion]
         [funimage.segmentation utils imp]
         [funimage.imp calibration roi threshold calculator statistics])
   (:import [net.imglib2.algorithm.neighborhood Neighborhood]


CMR-4239 - Added variable metadata validation back.

--- ingest-app/src/cmr/ingest/api/variables.clj
+++ ingest-app/src/cmr/ingest/api/variables.clj
@@ -13,6 +13,15 @@
    [cmr.ingest.services.ingest-service :as ingest]
    [cmr.ingest.validation.validation :as v]))

+(defn- validate-variable-metadata
+  "Validate variable metadata, throws error if the metadata is not a valid against the
+   UMM variable JSON schema."
+  [content-type headers metadata]
+  (let [concept (api-core/metadata->concept :variable metadata content-type headers)
+        concept (update-in concept [:format] ingest/fix-ingest-concept-format)]
+    (v/validate-concept-request concept)
+    (v/validate-concept-metadata concept)))
+
 (defn ingest-variable
   "Processes a request to create or update a variable."
   [provider-id native-id request]
@@ -23,8 +32,7 @@
     (acl/verify-ingest-management-permission
      request-context :update :provider-object provider-id)
     (common-enabled/validate-write-enabled request-context "ingest")
-    ;; XXX Once the variable schema solidifies, we'll need to add validation
-    ;; here, before the save that happens in the threading macro.
+    (validate-variable-metadata content-type headers (:metadata concept))
     (->> (api-core/set-user-id concept request-context headers)
          (ingest/save-variable request-context)
          (api-core/generate-ingest-response headers))))


(SERVER-1111) Further schematized the environment classes data types

This commit adds some more use of schema around the return structure
from a call to the environment_classes endpoint.

--- src/clj/puppetlabs/services/master/master_core.clj
+++ src/clj/puppetlabs/services/master/master_core.clj
@@ -22,11 +22,94 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Private

+(def EnvironmentClassesFileClassParameter
+  "Schema for an individual parameter found in a class defined within an
+  environment_classes file.  Includes the name of the parameter.  Optionally,
+  if available in the parameter definition, includes the type, source text for
+  the parameter's default value, and a literal (primitive data type)
+  representation of the parameter's default value.
+
+  For example, if a class parameter were defined like this in a Puppet
+  manifest ...
+
+    Integer $someint = 3
+
+  ... then the map representation of that parameter would be:
+
+  {:name \"someint\",
+   :type \"Integer\",
+   :default_source \"3\",
+   :default_literal 3
+  }
+
+  For a parameter default value which contains an expression - something that
+  cannot be coerced into a primitive data type - the map representation omits
+  the default_literal.  For example, this parameter definition in a Puppet
+  manifest ...
+
+   String $osfam = \"$::osfamily\"
+
+  ... would produce a map representation which looks like this ...
+
+  {:name \"osfam\",
+   :type \"String\",
+   :default_source \"\"$::osfamily\"\",
+  }
+
+  The data types that could be used in the value for a :default_literal may
+  vary over time, as the Puppet language continues to evolve.  For this
+  reason, the more permissive schema/Any is used here.  General data types
+  that we could see based on current types that the Puppet language allows
+  today are in the table below:
+
+  Puppet          | :default_literal value
+  ================================================
+  String          | java.lang.String
+  Boolean         | java.lang.Boolean
+  Float/Numeric   | java.lang.Double
+  Integer/Numeric | java.lang.Long
+  Array           | clojure.lang.LazySeq
+  Hash            | clojure.lang.PersistentTreeMap
+
+  For the Regexp, Undef, Default, any Hash objects (top-level or nested within
+  another Array or Hash) whose keys are not of type String, and any Array
+  or Hash objects (top-level or nested within another Array or Hash) which
+  contain a Regexp, Undef, or Default typed value, the :default_literal value
+  will not be populated.  These are not populated because they cannot be
+  represented in JSON transfer without some loss of fidelity as compared to what
+  the original data type from the manifest was."
+  {:name schema/Str
+   (schema/optional-key :type) schema/Str
+   (schema/optional-key :default_source) schema/Str
+   (schema/optional-key :default_literal) schema/Any})
+
+(def EnvironmentClassesFileClass
+  "Schema for an individual class found within an environment_classes file
+  entry.  Includes the name of the class and a vector of information about
+  each parameter found in the class definition."
+  {:name schema/Str
+   :params [EnvironmentClassesFileClassParameter]})
+
+(def EnvironmentClassesFileWithError
+  "Schema for an environment_classes file that could not be parsed.  Includes
+   the path to the file and an error string containing details about the
+   problem encountered during parsing."
+  {:path schema/Str
+   :error schema/Str})
+
+(def EnvironmentClassesFileWithClasses
+  "Schema for an environment_classes file that was successfully parsed.
+  Includes the path to the file and a vector of information about each class
+  found in the file."
+  {:path schema/Str
+   :classes [EnvironmentClassesFileClass]})
+
 (def EnvironmentClassesFileEntry
   "Schema for an individual file entry which is part of the return payload
   for an environment_classes request."
-  {:path schema/Str
-   schema/Keyword schema/Any})
+  (schema/conditional
+   #(contains? % :error) EnvironmentClassesFileWithError
+   #(contains? % :classes) EnvironmentClassesFileWithClasses))

 (def EnvironmentClassesInfo
   "Schema for the return payload an environment_classes request."


Clarify crashed log entry application.

Clarify crashed log entry application.

--- src/cljs/onyx_dashboard/components/deployment.cljs
+++ src/cljs/onyx_dashboard/components/deployment.cljs
@@ -37,7 +37,7 @@
                  :bs-style (if (or crashed? (not (:up-to-date? deployment)))  "danger" "primary")}
                 (dom/div
                   (if crashed?
-                    (dom/div "Log replay crashed. Cluster probably died if the dashboard is using the same version of Onyx."
+                    (dom/div "Log replay crashed. Cluster probably crashed, assuming the dashboard is using the same version of Onyx."
                              (dom/pre {}
                                       (:error (:status deployment)))))
                   (dom/div


Update ns_to_markdown.clj

Update ns_to_markdown.clj

--- docs/src/ns_to_markdown.clj
+++ docs/src/ns_to_markdown.clj
@@ -1,22 +1,19 @@
 (ns ns-to-markdown
-  "The purpose of this is to generate markdown documentation from the re-frame.core ns as input
-   to the mkdocs-based documentation site build. We use markdown because that delegates site
-   navigation, syntax highlighting and other useful features to the mkdocs build, making the
-   output of this script very simple. It also means there is seamless integration between the
-   generated api documentation, and the rest of the documentation site. All the styling is the same
-   and links work as expected etc.
+  "This script is used to generate the API documentation for the namespace `re-frame.core`. It reads the
+   source code in that namespace, extracts the docstrings (markdown) and produces a markdown-formatted
+   file suitable for providing to `mkdocs` which builds the re-frame website.

-   It is run as part of the GitHub Actions docs workflow at
+   It is used within the GitHub Actions docs workflow at:
    https://github.com/day8/re-frame/blob/78ca09785e2adf9eea11f1e4bff2477d193f4b46/.github/workflows/docs-workflow.yml#L15

-   The page that results from this is http://day8.github.io/re-frame/api-re-frame.core/
+   The page it outputs can be seen here: http://day8.github.io/re-frame/api-re-frame.core/

    Usage: clojure -m ns-to-markdown ../src/re_frame/core.cljc > api-re-frame.core.md

    Run as a script with the Clojure CLI. Expects the first arg to be a path to a ClojureScript
    namespace. Reads the single namespace found in that file using the ClojureScript analyzer,
    extracting public var metadata such as function names, arglists and docstrings. Subsequently
-   writes it out as markdown to stdout suitable for piping to a markdown file as per usage example."
+   writes it out as markdown to stdout suitable for piping to a markdown file."
   (:require
     [clojure.java.io :as io]
     [cljs.analyzer]


get test coverage working

get test coverage working

--- test/sicp/L2/fixedPoint_test.clj
+++ test/sicp/L2/fixedPoint_test.clj
@@ -4,6 +4,6 @@
             [sicp.L2.fixedPoint :refer :all]))

-;(deftest fixedPoint-test
-;  (is (close? 1 (fixedPoint (fn [x] (+ x (/ 1 x))) 10.0) 125.0))
-;  )
+(deftest fixedPoint-test
+  (is (close? 1 (fixedPoint (fn [x] (+ x (/ 1 x))) 10.0) 125.0))
+  )


Disallow generators to create reserved symbols.

--- test/smallex/test/generators.clj
+++ test/smallex/test/generators.clj
@@ -23,8 +23,8 @@
                :string)}))

 (def string
-  (gen/fmap string->item-string
-            (gen/not-empty gen/string-alpha-numeric)))
+  (->> (gen/not-empty gen/string-alpha-numeric)
+       (gen/fmap string->item-string)))

 (defn use-alias [aliases]
   (gen/elements aliases))
@@ -119,11 +119,13 @@
   (let [alias-gen (if (seq prev-aliases)
                     (gen/elements prev-aliases)
                     string) ;; avoid throwing when empty
-        alias-name (gen/such-that #(and (seq %)
-                                        (Character/isLetter (first %))
-                                        (not-any? (fn [e] (= % (:value e)))
-                                                  prev-aliases))
-                                  (gen/resize 20 gen/string-alpha-numeric))
+        alias-name (gen/such-that
+                    #(and (seq %)
+                          (Character/isLetter (first %))
+                          (not-any? (fn [e] (= % (:value e))) prev-aliases)
+                          (not (contains? #{"or" "cat" "star" "alias" "def"
+                                            "plus" "opt"} %)))
+                    (gen/resize 20 gen/string-alpha-numeric))
         expr (expression alias-gen)]
     (->> (gen/tuple alias-name expr)
          (gen/fmap (fn [[alias-name expr]]
@@ -150,10 +152,13 @@
         alias-gen (if (seq alias-items)
                     (gen/elements alias-items)
                     string) ;; avoid throwing when empty
-        rule-name-gen (gen/such-that #(and (seq %)
-                                           (Character/isLetter (first %))
-                                           (not (contains? alias-names %)))
-                                     (gen/resize 20 gen/string-alpha-numeric))]
+        rule-name-gen (gen/such-that
+                       #(and (seq %)
+                             (Character/isLetter (first %))
+                             (not (contains? alias-names %))
+                             (not (contains? #{"or" "cat" "star" "alias" "def"
+                                               "plus" "opt"} %)))
+                       (gen/resize 20 gen/string-alpha-numeric))]
     (->> (gen/map rule-name-gen (expression alias-gen))
          (gen/not-empty)
          (gen/fmap (fn [m] ;; tag on priority on rules


Workaround for IOS touch events.

Workaround for IOS touch events.

--- src/cljs/munchkin_toolbox/core.cljs
+++ src/cljs/munchkin_toolbox/core.cljs
@@ -82,7 +82,8 @@
                   :on-click #(put! label-changed label)}
                  "Save"]]
                [:label
-                {:on-click #(om/set-state! owner :edit? true)}
+                {:style {:cursor "pointer"}
+                 :on-click #(om/set-state! owner :edit? true)}
                 (get data label-key "")])]]))))))

 (defmulti change-level identity)


Better deprecation section

Better deprecation section

--- src/cljs/onyx_cheat_sheet/core.cljs
+++ src/cljs/onyx_cheat_sheet/core.cljs
@@ -185,17 +185,12 @@
               (for [c conditions]
                 (dom/li {} (codify c)))])))

-(defn deprecated-version [section k]
+(defn deprecated [section k]
   (when-let [deprecated-version (get-in model [section :model k :deprecated-version])]
     (r/alert {:bs-style "danger"}
-             [(dom/h5 {} "Deprecated Version")
-              deprecated-version])))
-
-(defn deprecated-doc [section k]
-  (when-let [deprecation-doc (get-in model [section :model k :deprecation-doc])]
-    (r/alert {:bs-style "danger"}
-             [(dom/h5 {} "Deprecation Doc")
-              deprecation-doc])))
+             [(dom/h5 {} "Deprecated")
+              (dom/p {} deprecated-version)
+              (dom/p {} (get-in model [section :model k :deprecation-doc]))])))

 (defn keyword-sanitize-? [k]
   (if (namespace k)
@@ -214,8 +209,7 @@
                        (if deprecated?
                          (r/badge {:class "deprecated-badge onyx-badge"} "deprecated"))
                        (requirements section k))
-              (deprecated-version section k)
-              (deprecated-doc section k)
+              (deprecated section k)
               (r/well {:class "entry-doc"} (codify (get-in model [section :model k :doc])))
               (restrictions model section k)
               (dom/p {})


Dump more information to try to determine why Tron isn't getting host/port

--- src/clojure/funcatron/tron/core.clj
+++ src/clojure/funcatron/tron/core.clj
@@ -81,10 +81,12 @@

   (info (str "Starting Funcatron. Args: " args))
   (info (str "Version " version-info))
+  (info (str "Env Vars" (System/getenv)))
   (let [opts (merge
                (cli/parse-opts args the-opts/cli-options)
                (cli/parse-opts (ordered-tron-env (System/getenv)) the-opts/cli-options)
                )]
+    (info "Computed command line options: " opts)
     (reset! the-opts/command-line-options opts)
     (trace (str "Argument options: " opts))
     (cond


Update call to random-plush-instruction-map in genome_gene_randomize

This commit is not tested.

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -46,6 +46,7 @@
              (push-item (concat (take index genome)
                                 (list (random-plush-instruction-map
                                         @global-atom-generators
+                                        true
                                         {:epigenetic-markers @global-epigenetic-markers
                                          :close-parens-probabilities @global-close-parens-probabilities
                                          :silent-instruction-probability @global-silent-instruction-probability}))


Fixed bug in return_tagspace.

Fixed bug in return_tagspace.

--- src/clojush/instructions/return.clj
+++ src/clojush/instructions/return.clj
@@ -74,6 +74,8 @@
 (define-registered
   return_tagspace
   (fn [state]
-    (let [top-env (top-item :environment state)
-          new-env (assoc top-env :tag (:tag state))]
-      (push-item new-env :environment (pop-item :environment state)))))
+    (if (empty? (:environment state))
+      state
+      (let [top-env (top-item :environment state)
+            new-env (assoc top-env :tag (:tag state))]
+        (push-item new-env :environment (pop-item :environment state))))))


comments and :refers

comments and :refers

--- src/babel/italiano/benchmark.cljc
+++ src/babel/italiano/benchmark.cljc
@@ -1,6 +1,6 @@
 (ns babel.italiano.benchmark
   (:refer-clojure :exclude [get-in])
-  (:require [babel.italiano :as italiano :refer [analyze parse]]
+  (:require [babel.italiano :as italiano :refer [analyze generate morph parse]]
             [babel.italiano.grammar :as grammar]
             [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
             [babel.italiano.morphology.nouns :as nouns]
@@ -13,8 +13,9 @@
             [clojure.string :as string]
             [dag_unify.core :refer [get-in strip-refs]]))

-;; Creating a language model is expensive so we'll do it once before running any benchmarks..
+;; Creating language models is expensive so we'll create them before running any benchmarks..
 (def small (grammar/small))
+(def medium (grammar/medium))

 (defn exception [error-string]
   #?(:clj
@@ -88,5 +89,3 @@
                 :root {:italiano {:italiano "andare"}}}
                small
                do-this-many)))
-
-


diagnostics: print semantics of generated expression if parsing fails for surface of expression

--- src/babel/italiano/benchmark.cljc
+++ src/babel/italiano/benchmark.cljc
@@ -28,7 +28,9 @@
                               (println (str "starting parsing.."))
                               (let [parsed (time (take 1 (parse (fo expr))))]
                                 (if (empty? parsed)
-                                  (throw (exception (str "could not parse: " (fo expr)))))
+                                  (throw (exception (str "could not parse: " (fo expr) " with semantics:"
+                                                         (strip-refs (get-in expr [:synsem :sem]))))))
+
                                 (println (str "parsed: " (fo (first parsed))))
                                 (println "")))))))
 (defn -main [times]


Add debug logging of HTTP requests

Add debug logging of HTTP requests

--- src/braid/core/server/handler.clj
+++ src/braid/core/server/handler.clj
@@ -11,11 +11,12 @@
    [ring.middleware.cors :refer [wrap-cors]]
    [ring.middleware.defaults :refer [wrap-defaults api-defaults secure-site-defaults site-defaults]]
    [ring.middleware.format :refer [wrap-restful-format]]
-   [ring.middleware.edn :refer [wrap-edn-params]]))
+   [ring.middleware.edn :refer [wrap-edn-params]]
+   [taoensso.timbre :as timbre]))

 (def session-max-age (* 60 60 24 365))

-; NOT using config here, b/c it won't have started when this runs
+;; NOT using config here, b/c it won't have started when this runs
 (if (env :redis-uri)
   (do
     (require 'taoensso.carmine.ring)
@@ -57,19 +58,29 @@
                :content-types          true
                :default-charset        "utf-8"}})

+(defn- wrap-log-requests
+  [handler]
+  (fn [{uri :uri method :request-method :as request}]
+    (let [t0 (System/currentTimeMillis)
+          {:keys [status] :as response} (handler request)]
+      (timbre/debugf "[%s +%4dms] %8.8s %s" status (- (System/currentTimeMillis) t0) method uri)
+      response)))
+
 (def mobile-client-app
   (-> (routes
-        resource-routes
-        mobile-client-routes)
+       resource-routes
+       mobile-client-routes)
       (wrap-defaults (-> static-site-defaults
-                         assoc-cookie-conf))))
+                         assoc-cookie-conf))
+      wrap-log-requests))

 (def desktop-client-app
   (-> (routes
-        resource-routes
-        desktop-client-routes)
+       resource-routes
+       desktop-client-routes)
       (wrap-defaults (-> static-site-defaults
-                         assoc-cookie-conf))))
+                         assoc-cookie-conf))
+      wrap-log-requests))

 (def api-server-app
   (-> (routes
@@ -112,4 +123,5 @@
                                                   (remove nil?))
                  :access-control-allow-credentials true
                  :access-control-allow-methods [:get :put :post :delete])
-      wrap-edn-params))
+      wrap-edn-params
+      wrap-log-requests))


Update words.clj

Update words.clj

--- src/iyye/subcon/knowledge/words.clj
+++ src/iyye/subcon/knowledge/words.clj
@@ -22,92 +22,118 @@
     ;[iyye.subcon.knowledge.relation :as relation]
     ))

-(def action-words (ref []))
-(def noun-words (ref []))
+(def action-words (ref {}))
+(def noun-words (ref {}))
 ;(def types-words (ref []))
 ;(def relations-words (ref []))
-(def instances-words (ref []))
-(def adjective-words (ref []))
+;(def instances-words (ref []))
+;(def adjective-words (ref []))

 (defrecord Iyye_ModalPredicate [AccordingTo When Time Prob])
-(defrecord Iyye_Atom [Name Uname])
-(defrecord Iyye_Relation [atom Predicate Types Function Data])
+(defrecord Iyye_Atom [Name Uname Builtin])
+(defrecord Iyye_Relation [atom Predicate Types Function PredicateFunction Data])
 (defrecord Iyye_Type [atom Relations])
 (defrecord Iyye_Instance [atom type])

-(defn create-iyye-atom [name words-list]
-  (let [Time (persistence/current-time-to-string)
-        uname (str name (count words-list))
-        atom (->Iyye_Atom name uname)]
+(defn create-iyye-atom [name words-list & builtin]
+  (let [uname (str name (count words-list))
+        b (if (nil? builtin) false (first builtin))
+        atom (->Iyye_Atom name uname b)]
     atom))

-(defn create-iyye-type [Name]
-  (let [type-atom (create-iyye-atom Name noun-words)
+(defn create-iyye-type [Name & builtin]
+  (let [type-atom (create-iyye-atom Name noun-words builtin)
         type (->Iyye_Type type-atom [])]
     type))

-(defn create-iyye-relation [Name AccordingTo Reason When Types Function]
-  (let [action-atom (create-iyye-atom Name @noun-words)
-        relation (->Iyye_Relation action-atom Reason Types Function [])]
+(defn create-iyye-relation [Name Predicate Types Function PredicateFunction & builtin]
+  (let [action-atom (create-iyye-atom Name @noun-words builtin)
+        relation (->Iyye_Relation action-atom Predicate Types Function PredicateFunction [])]
     relation))

 (defn create-iyye-instance [values])

 (defn load-iyye-atom-from-db [uname])

+(defn load-iyye-atoms-from-db [name & [dbname]])
+
 (defn load-iyye-types-from-db [name]
+  (load-iyye-atoms-from-db name "types"))
+
+(defn save-iyye-type-to-db [type]
   )

 (defn load-iyye-relations-from-db [name]
-  )
+  (load-iyye-atoms-from-db name "relations"))
+
+(defn get-iyye-atoms [name builtins dbname]
+  (let [builtin-types #(for [word @builtins :when (= (:Name word) name)] word)
+        loaded-types (load-iyye-atoms-from-db name dbname)]
+    (if (empty? builtin-types)
+      (if (empty? loaded-types)
+        :UNKNOWN
+        loaded-types)
+      (if (empty? loaded-types)
+        builtin-types
+        (apply conj builtin-types loaded-types)))))

 (defn get-iyye-types [name]
-  (let [builtin-types #(for [word @noun-words :when (= (:Name word) name)] word)
-        loaded-types (load-iyye-types-from-db name)]
-      (if (empty? builtin-types)
-        (if (empty? loaded-types)
-          :UNKNOWN
-          loaded-types)
-        (if (empty? loaded-types)
-          builtin-types
-          (apply conj builtin-types loaded-types)))))
+  (get-iyye-atoms name noun-words "types"))

 (defn set-iyye-type! [type]
-  )
+  (let [uname (:Uname (:atom type))
+        builtin (:Builtin (:atom type))]
+(do (dosync (alter noun-words assoc @noun-words uname type))
+    (when builtin
+      (save-iyye-type-to-db type)))
+    ))
+
+; (defn get-iyye-relations [name]
+  ; (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)
+  ;       loaded-relations (load-iyye-relations-from-db name)]
+  ; (if (empty? builtin-relations)
+  ; (if (empty? loaded-relations)
+  ;       :UNKNOWN
+  ;      loaded-relations)
+  ; (if (empty? loaded-relations)
+  ;        builtin-relations
+  ;        (apply conj builtin-relations loaded-relations)))))

 (defn get-iyye-relations [name]
-  (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)
-        loaded-relations (load-iyye-relations-from-db name)]
+  (let [builtin-relations #(for [word @action-words :when (= (:Name word) name)] word)]
     (if (empty? builtin-relations)
-      (if (empty? loaded-relations)
-        :UNKNOWN
-        loaded-relations)
-      (if (empty? loaded-relations)
-        builtin-relations
-        (apply conj builtin-relations loaded-relations)))))
+      :UNKNOWN
+      builtin-relations)))

 (defn check-params [action params]
   (let [act-params (:Types action)]
-  (compare act-params (map #(:Name (:atom %)) params))))
+    (compare act-params (map #(:Name (:atom %)) params))))

-;(dosync (alter types-words conj type))
-;(persistence/write-noun-to-db (into {} type))
+  ;(dosync (alter types-words conj type))
+  ;(persistence/write-noun-to-db (into {} type))

 (defn apply-relation [relation params]
   (when (check-params relation params)
     ((:Function relation) params)))

-(defn action [cmd params IO]
+(defn apply-query [relation params]
+  (when (check-params relation params)
+    ((:PredicateFunction relation) params)))
+
+(defn- run-action [cmd params IO func]
   (let [actions-list (get-iyye-relations cmd)
         params-list (map get-iyye-types params)]
     (case (count actions-list)
       0 (ioframes/process-output IO (str "failed to parse: no matching action to " cmd))
       1 (let [action (first actions-list)]
-          (when (not (apply-relation action params-list))
+          (when (not (func action params-list))
             (ioframes/process-output IO (str "failed to parse: types mismatch " cmd ": " action ":" params))))
-
       (let [matching-actions (for [action @actions-list :when (check-params action params-list)] action)]
         (if (empty? matching-actions)
           (ioframes/process-output IO (str "failed to parse: no many matched parameters to " cmd ": " actions-list))
-          ((:Function (first matching-actions)) params-list))))))                     ; FIXME Yumzya first
+          (func (first matching-actions) params-list)))))) ; FIXME Yumzya first

+(defn action [cmd params IO]
+  (if (= \? (last cmd))
+    (run-action (subs cmd 0 (dec (count cmd))) params IO apply-query)
+    (run-action cmd params IO apply-relation)))