Some tidying.

Some tidying.

--- test/clojure_the_language/clojure_numerics_test.clj
+++ test/clojure_the_language/clojure_numerics_test.clj
@@ -22,7 +22,8 @@
 (fact (type 2.0)   => Double)
 (fact (type 2.0)   => java.lang.Double)

-(fact (type 4/2) => Long)
+(fact "Ratios are turned into Longs if possible"
+  (type 4/2) => Long)

 ;;; Some non-Clojure Java numeric types

@@ -88,9 +89,13 @@
 ;;; I think there's a problem with the doc string:
 ;;; - What does it mean by "in a type-independent manner"?
 ;;;   - Is this defined in any authoritative place?
+;;;   - The doc string for `==` uses the phrase "type-independent" with a
+;;;     different (and intuitive) meaning.
 ;;; - I would expect e.g. (= 2 2M) => true, but that's not so.
 ;;;   - I'm not the only one:
 ;;;     - See http://dev.clojure.org/jira/browse/CLJ-1333.
+
+;;; Jeez, Clojure is poorly specified in places.

 ;;; /Clojure Programming/ p433-444 was helpful.

@@ -102,8 +107,6 @@
 ;;;   - arbitrary-precision decimals (e.g. 2M, 2.0M)
 ;;;   - limited-precision decimals (e.g. 2.0, (Float. 2.0))

-;;; Jeez, Clojure is poorly specified in places.
-
 ;;;; ---------------------------------------------------------------------------
 ;;;; ---- Things that are fine ----

@@ -131,10 +134,17 @@
 ;;;; ---- The thing that is, in my opinion, contrary to the doc string ----

 (fact "`=` return false for comparisons of equivalent numbers of different categories"
-  ;; From /Clojure Programming/
-  (fact (= 1 1.0) => false)
-  (fact (= 1N 1M) => false)
+  ;; From /Clojure Programming/ with some changes and additions
+  (fact (= 2 2.0)    => false)
+  (fact (= 2 2M)     => false)
+  (fact (= 2N 2M)    => false)
   (fact (= 1.25 5/4) => false))
+
+;;; From /Clojure Programming/:
+;;;   Clojure’s = could obviate these type differences (as Ruby and Python do),
+;;;   but doing so would impose some runtime cost that would be unappreciated by
+;;;   those who need to maximize the performance of programs that work with
+;;;   homogeneous numeric data.

 ;;;; ---------------------------------------------------------------------------
 ;;;; ---- My playing ----
@@ -189,18 +199,24 @@
 ;;;;   Returns non-nil if nums all have the equivalent value (type-independent),
 ;;;;   otherwise false.

+;;; The doc string uses the phrase "type-independent" in a way that has a
+;;; different meaning to that in the doc string for `=`.
+
+;;; From /Clojure Programming/:
+;;;   Clojure opts to provide a third notion of equality, specifically to
+;;;   address the need for type-insensitive equivalence tests.
+
 (fact (== 2 2N 2M 2.0M 2.0) => true) ; true even for inexact things

 ;;;; ___________________________________________________________________________

 (fact (type (- 2N 1N)) => clojure.lang.BigInt)
-
 (fact (type (/ 4N 2N)) => clojure.lang.BigInt)
 (fact (type (/ 2N 4N)) => clojure.lang.Ratio)

 ;;;; ___________________________________________________________________________
-;;;; ---- =-and-same-type ----
+;;;; ---- `=-and-same-type` ----

 (defn =-and-same-type
   "Returns true iff (= x y) is true and x and y are of the same type."


Bump chunk size to something more sensible

--- test/clojurewerkz/cassaforte/iterate_table_test.clj
+++ test/clojurewerkz/cassaforte/iterate_table_test.clj
@@ -16,7 +16,7 @@
         (insert s :users {:name (str "name_" i) :city (str "city" i) :age (int i)}))

       (let [res (group-by :name
-                          (take n (iterate-table s :users :name 10)))]
+                          (take n (iterate-table s :users :name 1024)))]
         (dotimes [i n]
           (let [item (first (get res (str "name_" i)))]
             (is (= {:name (str "name_" i) :city (str "city" i) :age (int i)}


Separate listen host and client connect host in log messages

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -25,14 +25,14 @@

 (defn- start-server [pod {:keys [ip port ws-host ws-port secure?] :as opts}]
   (let [{:keys [ip port]} (pod/with-call-in pod (adzerk.boot-reload.server/start ~opts))
-        host              (cond ws-host ws-host (= ip "0.0.0.0") "localhost" :else ip)
+        listen-host       (cond (= ip "0.0.0.0") "localhost" :else ip)
+        client-host       (cond ws-host ws-host (= ip "0.0.0.0") "localhost" :else ip)
         proto             (if secure? "wss" "ws")]
-    (util/with-let [url (format "%s://%s:%d" proto host (or ws-port port))]
-      (util/info "Starting reload server on %s\n" url))))
+    (util/info "Starting reload server on %s\n" (format "%s://%s:%d" proto listen-host port))
+    (format "%s://%s:%d" proto client-host (or ws-port port))))

 (defn- write-cljs! [f url ws-host on-jsload asset-host]
-  (util/info "Writing %s to connect to %s...\n" (.getName f)
-             (if ws-host url "default websocket host"))
+  (util/info "Writing %s to connect to %s...\n" (.getName f) url)
   (->> (bt/template
          ((ns adzerk.boot-reload
             (:require


Add command to add user plugin to workspace

Encourage users to explore and understand their settings and a plugin's
makeup

--- src/lt/objs/settings.cljs
+++ src/lt/objs/settings.cljs
@@ -249,6 +249,12 @@
               :exec (fn []
                       (cmd/exec! :open-path user-cljs-path))})

+
+(cmd/command {:command :user.add-user-plugin-to-workspace
+              :desc "Settings: Add User plugin to workspace"
+              :exec (fn []
+                      (object/raise workspace/current-ws :add.folder! user-plugin-dir))})
+
 (behavior ::on-close-remove
           :triggers #{:close}
           :reaction (fn [this]


Exit explicitly

Exit explicitly


add badges to a-z

add badges to a-z

indication the progress

--- src/checkmate/views/overview.clj
+++ src/checkmate/views/overview.clj
@@ -10,13 +10,16 @@
        [:div
         [:h4 letter]
         (for [i items]
-          [(keyword (format "div#%s.row" (:_id i)))
-           [:div.col-md-4
-            [:strong (elm/link-to (str "/show/" (:_id i)) (:name i))]]
-           [:div.col-md-8
-            [:div.btn-group
-             [:a {:class "btn btn-default btn-xs" :href (str "/edit/" (:_id i))} [:span.glyphicon.glyphicon-edit] "Edit"]
-             [:a {:class "btn btn-default btn-xs":href "#" :onclick (format "checkmate.views.overview.try_delete_list('%s', '%s');" (:_id i) (:name i))} [:span.glyphicon.glyphicon-trash] "Delete"]]]])])]))
+          (let [num-done (count (filter :checked? (:items i)))
+                num-all (count (:items i))
+                cls-link (keyword (if-not (= num-all num-done) "strong" "strong.checked"))]
+            [(keyword (format "div#%s.row" (:_id i)))
+             [:div.col-md-4
+              [cls-link (elm/link-to (str "/show/" (:_id i)) (:name i)) " " [:span.badge (str num-done "/" num-all)]]]
+             [:div.col-md-8
+              [:div.btn-group
+               [:a {:class "btn btn-default btn-xs" :href (str "/edit/" (:_id i))} [:span.glyphicon.glyphicon-edit] "Edit"]
+               [:a {:class "btn btn-default btn-xs":href "#" :onclick (format "checkmate.views.overview.try_delete_list('%s', '%s');" (:_id i) (:name i))} [:span.glyphicon.glyphicon-trash] "Delete"]]]]))])]))

 (defn render [lists]
   (let [grouped (group-by (comp first string/upper-case :name) lists)]


image reply fix

image reply fix

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

--- src/status_im/ui/screens/chat/components/reply.cljs
+++ src/status_im/ui/screens/chat/components/reply.cljs
@@ -7,7 +7,8 @@
             [status-im.ui.components.icons.vector-icons :as icons]
             [status-im.ethereum.stateofus :as stateofus]
             [status-im.ui.screens.chat.components.style :as styles]
-            [re-frame.core :as re-frame]))
+            [re-frame.core :as re-frame]
+            [status-im.ui.components.react :as react]))

 (def ^:private reply-symbol "↪ ")

@@ -26,7 +27,8 @@

 (defn reply-message [{:keys [from content]}]
   (let [contact-name       @(re-frame/subscribe [:contacts/contact-name-by-identity from])
-        current-public-key @(re-frame/subscribe [:multiaccount/public-key])]
+        current-public-key @(re-frame/subscribe [:multiaccount/public-key])
+        {:keys [image text]} content]
     [rn/view {:style (styles/reply-container false)}
      [rn/view {:style (styles/reply-content)}
       [quo/text {:weight          :medium
@@ -34,10 +36,17 @@
                  :style           {:line-height 18}
                  :size            :small}
        (format-reply-author from contact-name current-public-key)]
-      [quo/text {:size            :small
-                 :number-of-lines 1
-                 :style           {:line-height 18}}
-       (:text content)]]
+      (if image
+        [react/image {:style  {:width            56
+                               :height           56
+                               :background-color :black
+                               :margin-top       2
+                               :border-radius    4}
+                      :source {:uri image}}]
+        [quo/text {:size            :small
+                   :number-of-lines 1
+                   :style           {:line-height 18}}
+         text])]
      [rn/view
       [pressable/pressable {:on-press            #(re-frame/dispatch [:chat.ui/cancel-message-reply])
                             :accessibility-label :cancel-message-reply}


Updating tests to use constant a instead of :a

--- test/org/libraryweasel/ligature/core_test.clj
+++ test/org/libraryweasel/ligature/core_test.clj
@@ -46,8 +46,7 @@
     (is (not (s/valid? ::l/statement ["test" "test"])))
     (is (not (s/valid? ::l/statement ["test" "test" "g" "h" "e"])))
     (is (not (s/valid? ::l/statement [5 3 66 554])))
-    (is (not (s/valid? ::l/statement ["test" "test" :a])))
-    (is (s/valid? ::l/statement ["test" :a "test" "test"])))) ; TODO more test cases
+    (is (s/valid? ::l/statement ["test" l/a "test" "test"])))) ; TODO more test cases

 (deftest statements?-test
   (testing "Common examples"


fix wrong parenthesis

fix wrong parenthesis

--- src/clj/link_collective/core.clj
+++ src/clj/link_collective/core.clj
@@ -163,7 +163,7 @@

   (init server-state "resources/server-config.edn")

-  (def server (start-server (:port @server-state))
+  (def server (start-server (:port @server-state)))

   (server)


Only invoke add if all preconditions are meta

instead of just relying on enabling buttons

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -187,7 +187,9 @@
   [:div.form-group
    [:button.btn.btn-default
     {:on-click #(when (and (not (string/blank? @word))
-                           (hyphenation-valid? @hyphenation @word))
+                           (hyphenation-valid? @hyphenation @word)
+                           (not (contains? @hyphenations @word))
+                           (not= @hyphenation @suggested-hyphenation))
                   (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
      :disabled (when (or (string/blank? @word)
                          (not (hyphenation-valid? @hyphenation @word))


Add lift-placeholders version that works on AST

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -608,21 +608,27 @@
     (join env)
     ::continue))

+(defn lift-placeholders-ast
+  "This will lift the AST from placeholders to the same level of the query, as if there was not placeholders in it."
+  [env ast]
+  (walk/postwalk
+    (fn [x]
+      (if-let [children (:children x)]
+        (let [{placeholders true
+               regular      false} (group-by #(and (= :join (:type %))
+                                                   (placeholder-key? env (:dispatch-key %))) children)]
+          (as-> (assoc x :children (or regular [])) <>
+            (reduce merge-queries* <> placeholders)))
+        x))
+    ast))
+
 (defn lift-placeholders
   "This will lift the queries from placeholders to the same level of the query, as if there was not placeholders in it."
-  [{::keys [placeholder-prefixes] :as env} query]
-  (let [ast  (query->ast query)
-        ast' (walk/postwalk
-               (fn [x]
-                 (if-let [children (:children x)]
-                   (let [{placeholders true
-                          regular      false} (group-by #(and (= :join (:type %))
-                                                              (placeholder-key? env (:dispatch-key %))) children)]
-                     (as-> (assoc x :children (or regular [])) <>
-                           (reduce merge-queries* <> placeholders)))
-                   x))
-               ast)]
-    (ast->query ast')))
+  [env query]
+  (->> query
+       query->ast
+       (lift-placeholders-ast env)
+       ast->query))

 ;; BUILT-IN READERS


credit

credit

--- src/block_chain/wallet.clj
+++ src/block_chain/wallet.clj
@@ -9,6 +9,9 @@
      KeyFactory)
     (java.security.spec
      PKCS8EncodedKeySpec)))
+
+;; Thanks to http://nakkaya.com/2012/10/28/public-key-cryptography/
+;; for most of these snippets

 (java.security.Security/addProvider
  (org.bouncycastle.jce.provider.BouncyCastleProvider.))


minimum trie-threshold for URI is 1

minimum trie-threshold for URI is 1

--- src/calfpath/internal.cljc
+++ src/calfpath/internal.cljc
@@ -301,7 +301,8 @@

 (defn triefy-all
   [routes ^long trie-threshold uri-key]
-  (expected #(> ^long % 1) "value of :trie-threshold must be more than 1" trie-threshold)
+  (expected (every-pred
+              integer? pos?) "value of :trie-threshold must be positive integer" trie-threshold)
   (let [[with-uri no-uri] (split-routes-having-uri routes uri-key)]
     (if (> (count with-uri) trie-threshold)
       (-> (triefy with-uri trie-threshold uri-key)


Improve comment

Improve comment

--- src/re_frame/loggers.cljc
+++ src/re_frame/loggers.cljc
@@ -40,7 +40,7 @@

 (defn set-loggers!
   "Change the set (or a subset) of logging functions used by re-frame.
-  'new-loggers' should be a map which looks like default-loggers"
+  `new-loggers` should be a map with the same keys as `loggers` (above)"
   [new-loggers]
   (assert  (empty? (difference (set (keys new-loggers)) (-> @loggers keys set))) "Unknown keys in new-loggers")
   (swap! loggers merge new-loggers))


guard against referer header not set

guard against referer header not set

--- src/chat/server/routes.clj
+++ src/chat/server/routes.clj
@@ -79,7 +79,7 @@
                                                     :password (random-nonce 50)
                                                     :avatar avatar
                                                     :nickname nick}))
-                  referer (get-in req [:headers "referer"])
+                  referer (get-in req [:headers "referer"] (env :site-url))
                   [proto _ referrer-domain] (string/split referer #"/")]
               (db/with-conn
                 (db/user-add-to-group! id group-id)


Style changes to chess.cljs. Mostly cosmetic.

--- src/chessground/chess.cljs
+++ src/chessground/chess.cljs
@@ -3,10 +3,11 @@
   (:require [chessground.common :refer [pp]]
             [chessground.fen :as forsyth]))

-; Representation of a chess game:
-; {:pieces {"a1" {:color "white" :role "rook"}
-;           "b1" {:color "white" :role "knight"}
-;          }}
+(comment
+  ; Representation of a chess game:
+  {:pieces {"a1" {:color "white" :role "rook"}
+            "b1" {:color "white" :role "knight"}}}
+  )

 (def colors ["white" "black"])
 (def roles ["pawn" "rook" "knight" "bishop" "queen" "king"])
@@ -26,9 +27,9 @@

 (defn set-pieces [chess changes]
   (update-in chess [:pieces]
-             (fn [pieces] (reduce (fn [ps [key p]]
-                                    (if p (assoc ps key p) (dissoc ps key)))
-                                  pieces changes))))
+    (fn [pieces] (reduce (fn [ps [key p]]
+                           (if p (assoc ps key p) (dissoc ps key)))
+                   pieces changes))))

 (defn- count-pieces [chess] (count (:pieces chess)))


Removed requires left behind...

Removed requires left behind...

--- web/src/sound_effector/controllers/sound_effect.clj
+++ web/src/sound_effector/controllers/sound_effect.clj
@@ -3,8 +3,6 @@
     [clojure.string :as string]
     [clojure.data.json :as json]
     [ring.util.response :refer [redirect]]
-    [ring.middleware.format :refer [wrap-restful-format]]
-    [ring.middleware.format-response :refer [wrap-restful-response]]
     [ring.middleware.params :refer [params-request]]
     [compojure.core :refer [defroutes context GET POST DELETE]]
     [compojure.coercions :refer [as-int]]


assoc coerced :houses system in :result

assoc coerced :houses system in :result

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -100,7 +100,7 @@
                               0 ;; TODO: flags?
                               (:lat (:geo want))
                               (:lon (:geo want))
-                              (int (coerce-houses (:houses want)))
+                              (int (result re :houses (coerce-houses (:houses want))))
                               cusps
                               ascmc)]
           (merge


enable abilities of ICE installed by Howler

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -528,6 +528,7 @@
                                        (swap! state update-in (cons :corp (:zone target))
                                               (fn [coll] (remove-once #(not= (:cid %) (:cid target)) coll)))
                                        (update! state side (assoc card :howler-target newice))
+                                       (card-init state side newice false)
                                        (trigger-event state side :corp-install newice)))} card nil)))}]
     :events {:run-ends {:req (req (:howler-target card))
                         :effect (effect (trash card {:cause :self-trash})


public test connection

public test connection

--- src/clj/lesezeichen/db.clj
+++ src/clj/lesezeichen/db.clj
@@ -21,7 +21,7 @@

 (def db-uri-base "datomic:free://0.0.0.0:4334")

-(defn- scratch-conn
+(defn scratch-conn
   "Create a connection to an anonymous, in-memory database."
   []
   (let [uri (str "datomic:mem://" (d/squuid))]
@@ -49,8 +49,8 @@
      [{:db/id (d/tempid :db.part/user)
        :user/token token
        :user/email email}])
-    (send-registry email token)
-    :done))
+    #_(send-registry email token)
+    token))

 (defn- get-user-id [conn email]
@@ -75,7 +75,7 @@
 (defn get-bookmark
   "Retrieve bookmark"
   [conn {:keys [url email]}]
-  (let [query '[:find ?url ?title ?tx
+  (let [query '[:find ?url ?title ?tx ?email
                :in $ ?url ?email
                :where
                [?bm :bookmark/url ?url ?tx]
@@ -86,7 +86,7 @@
     (mapv
      (fn [bookmark]
        (update-in
-        (zipmap [:url :title :ts] bookmark)
+        (zipmap [:url :title :ts :email] bookmark)
         [:ts]
         #(:db/txInstant (d/entity (d/db conn) %))))
      (d/q query db url email))))
@@ -139,9 +139,11 @@
   [conn]
   (map
    first
-   (d/q '[:find ?email
+   (d/q '[:find ?email ?token
           :where
-          [?e :user/email ?email]]
+          [?e :user/email ?email]
+          [?e :user/token ?token]
+          ]
         (d/db conn))))

@@ -158,9 +160,10 @@

 (comment

-  (def conn (scratch-conn))
+  (def conn (db-conn))

   (init-schema conn "schema.edn")
+

   (def new-token (add-user conn {:email "eve@topiq.es"}))

@@ -188,4 +191,6 @@
          (zipmap users)
          aprint))

+  (get-all-users conn)
+
   )


Email verification: skip mtime limit check for now

--- src/clj/salava/user/db.clj
+++ src/clj/salava/user/db.clj
@@ -214,7 +214,8 @@
   (let [{:keys [user_id email verified verification_key mtime]} (select-email-by-verification-key {:verification_key key :user_id user-id} (into {:result-set-fn first} (get-db ctx)))
         verified-emails (verified-email-addresses ctx user-id)]
     (try+
-     (if-not (and email (= user_id user-id) (not verified) (= key verification_key) (>= mtime (- (unix-time) 86400)))
+      ;; Skip mtime limit check for now. Enable again after email sending problems are resolved.
+      (if-not (and email (= user_id user-id) (not verified) (= key verification_key) #_(>= mtime (- (unix-time) (* 5 24 60 60))))
        (throw+ {:status "error"}))
      (if-not activated
        (update-user-activate! {:id user_id} (get-db ctx)))


rn applicable summable

rn applicable summable

--- src/cljx/commos/delta.cljx
+++ src/cljx/commos/delta.cljx
@@ -5,6 +5,7 @@
   [ks]
   (if (coll? ks) ks [ks]))

+;; Adding deltas
 (defn- add-root-delta
   [val op new-val]
   (case op
@@ -22,8 +23,7 @@
     (add-root-delta val op korks-or-new-val)))

 (defn add
-  "Reducing function to apply a delta to a streamed compound EDN
-  value."
+  "Reducing function to add a delta to a streamed compound EDN value."
   ([] nil)
   ([val] val)
   ([val [op & maybe-deltas :as delta]]
@@ -60,7 +60,7 @@
 (defn diagnostic-delta
   "Bring delta into diagnostic form [op ks (v | [v+])].  v is a
   collection for :in and :ex ops.  This form is not applicable for add
-  as ks can be [], which is invalid.
+  as ks can be [], which is invalid. See summable-delta.

   Not suitable for :batch deltas (use unpack) beforehand."
   [[op korks-or-new-val new-val :as delta]]
@@ -70,8 +70,8 @@
     (not (#+clj identical? #+cljs keyword-identical? op :is))
     (update-in [2] collect)))

-(defn applicable-delta
-  "Bring a delta from diagnostic form into applicable form."
+(defn summable-delta
+  "Make a diagnostic applicable for add again."
   [[op korks new-val :as delta]]
   (if (seq korks)
     delta


removed to narrow type hints.

removed to narrow type hints.

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -460,7 +460,7 @@

 (defn partitions
   "Returns a vector of partitions for a given JavaRDD"
-  [^JavaRDD javaRdd]
+  [javaRdd]
   (into [] (.partitions (.rdd javaRdd))))

@@ -483,7 +483,7 @@

 (defn foreach-partition
   "Applies the function `f` to all elements of `rdd`."
-  [^JavaRDD rdd f]
+  [rdd f]
   (.foreachPartition rdd (void-function (comp f iterator-seq))))

@@ -516,9 +516,9 @@

 (defn rdd-name
-  ([^JavaRDD rdd name]
+  ([rdd name]
    (.setName rdd name))
-  ([^JavaRDD rdd]
+  ([rdd]
    (.name rdd)))


Fix a bug in JavaSchemaRDD

Fix a bug in JavaSchemaRDD

--- src/clojure/flambo/sql.clj
+++ src/clojure/flambo/sql.clj
@@ -74,7 +74,7 @@
 (extend-type JavaSchemaRDD
   PHasSQLContext
   (^JavaSQLContext get-java-sql-context [this]
-    (get-java-sql-context this)))
+    (get-java-sql-context (.schemaRDD this))))

 (def print-schema (memfn printSchema))


Fixed broken build caused by earlier refactoring adding to the core utilities

--- collectors/snapshot/test/snapshot_collector/snapshot_test.clj
+++ collectors/snapshot/test/snapshot_collector/snapshot_test.clj
@@ -1,5 +1,6 @@
 (ns snapshot-collector.snapshot-test
   (:require [midje.sweet :refer :all]
+            [kuona-core.util :as util]
             [snapshot-collector.snapshot :refer :all]))

 (facts "about data extraction"
@@ -121,8 +122,8 @@

 (facts "about json requests"
        (fact "content type is application/json"
-         (:headers (build-json-request {})) => {"content-type" "application/json; charset=UTF-8"})
+         (:headers (util/build-json-request {})) => {"content-type" "application/json; charset=UTF-8"})
        (fact "handles empty json object"
-         (:body (build-json-request {})) => "{}")
+         (:body (util/build-json-request {})) => "{}")
        (fact "converts hashmap to json text"
-         (:body (build-json-request {:key :value})) => "{\"key\":\"value\"}"))
+         (:body (util/build-json-request {:key :value})) => "{\"key\":\"value\"}"))


basic login form

basic login form

--- src/greybear/server.clj
+++ src/greybear/server.clj
@@ -32,9 +32,19 @@
        (javascript-tag (format "goboard.draw(\"goBoard\", %s, 1, function(x, y) {console.log(x, y)}, 18, 17);"
                                (stones-to-js (game :stones))))])}))

+(def login
+  (html5
+   [:body
+    [:div#login
+     (form-to [:post "/login"]
+              [:div#username (text-field "username")]
+              [:div#password (password-field "password")]
+              (submit-button "login"))]]))
+
 (defroutes main-routes
   (GET "/games/:id" [id :as {session :session}]
        (games-page session (Integer. id)))
+  (GET "/login" [] login)
   (route/resources "/")
   (route/not-found "Page not found"))


Do not fail when textarea is not on page

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -11,7 +11,7 @@

 (defn show-harnocode! [harnocode]
   (let [output-area (dom/getElement "output")]
-    (set! (.-value output-area) harnocode)))
+    (when output-area (set! (.-value output-area) harnocode))))


No spaces before and after punctuation.

No spaces before and after punctuation.

Still need to improve things.

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -29,7 +29,7 @@
 ;; Insert spaces between terms so they occupy exactly l chars
 ;; TODO: make spacing more even
 (defn insert-spaces [terms l]
-  (let [terms-interleaved (butlast (interleave terms (cycle " "))) ;; TODO: need better interleave that would work as string.join (without last space)
+  (let [terms-interleaved terms ;; TODO: need better interleave that would work as string.join (without last space)
         spaces-needed (- l (apply + (map count terms-interleaved)))
         f (fn [terms _] (insert terms (inc (rand-int (- (count terms) 1))) " "))]
     (string/join (reduce f terms-interleaved (range spaces-needed)))))
@@ -37,7 +37,7 @@
 ;; Best try on filling "column" of l subsequent ones with one or more tokens
 (defn fill-column [ts l]
   (let [f (fn [terms-so-far term]
-            (if (>= (apply + (map #(+ 1 (count %)) terms-so-far)) l)
+            (if (>= (apply + (map count terms-so-far)) l)
               (reduced terms-so-far)
               (conj terms-so-far term)))
         terms-that-fit (reduce f [(first ts)] (rest ts))
@@ -67,6 +67,20 @@
     (let [[line ts-rest] (arrange-tokens-line ts (first img))]
       (conj (arrange-tokens ts-rest (rest img)) line))))

+
+(defn analyze-code [code]
+  (let [tokens (js->clj (js/esprima.tokenize code) :keywordize-keys true)
+        token-to-text (fn [token] (if (= (:type token) "Punctuator")
+                                    (str (:value token))
+                                    (str (:value token))))]
+    (println (map :value tokens))
+    (map :value tokens)))
+
+;; TODO: smarter whitespace handling -- we don't need that much whitespace
+(defn token-to-text [token]
+  (if (= (:type token) "Punctuator")
+   (str (:value token))
+   (str (:value token) " ")))

 ;; Tries hard to make piece of code look like img
 ;; code -- string
@@ -74,11 +88,9 @@
 ;; w    -- int, width of output, in chars
 (defn harnify [code img w]
   (let [tokens (js->clj (js/esprima.tokenize code) :keywordize-keys true)
-        ts (map :value tokens)]
-    (comment apply str (interleave ts (repeat " ")))
+        ts (map token-to-text tokens)]
     (string/join "\n" (reverse (arrange-tokens ts img)))              ; img must be resized by now, no need in w
     ))
-

 (let [code      "function skipComment() {
         var ch, start;
@@ -135,16 +147,20 @@
             }
         }
     }"
-      img       [[0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]
-                 [0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1]]
+      img       [[0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]
+                 [0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1]]
       width     (count (first img))
       harnocode (harnify code img width)]
   (show-harnocode! harnocode))


spaces commit

spaces commit

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -501,9 +501,7 @@
                                        :mesos-dns (cluster-output-of "aws_elb" "internal-lb" "dns_name")
                                        :alerts-server (str "alerts." (vpc/vpc-dns-zone vpc-name))
                                        :logstash-ip (remote-output-of "vpc" "logstash-ip")}
-                                :lifecycle { :create_before_destroy true }
-
-                                })
+                                :lifecycle { :create_before_destroy true }})

              (asg "slaves"


Fix comment.

Fix comment.

--- test/clojure_the_language/clojure_numerics_test.clj
+++ test/clojure_the_language/clojure_numerics_test.clj
@@ -259,7 +259,6 @@
       => Long/MIN_VALUE)))

 ;;;; ___________________________________________________________________________
-;;;; ---- Going from BigInts to smaller ----
 ;;;; ---- Going from BigInts to other things ----

 (fact "Does not demote from BigInt"


Render through fbo

Render through fbo

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -426,31 +426,41 @@
       (println (GL20/glGetShaderInfoLog shader-id 10000)))
     [gl-compile-status shader-id]))

+(defn- program-id [vs-id fs-id & attribute-names]
+  (let [pgm-id                (GL20/glCreateProgram)
+        _ (except-gl-errors "@ let init-shaders glCreateProgram")
+        _                     (GL20/glAttachShader pgm-id vs-id)
+        _ (except-gl-errors "@ let init-shaders glAttachShader VS")
+        _                     (GL20/glAttachShader pgm-id fs-id)
+        _ (except-gl-errors "@ let init-shaders glAttachShader FS")
+        _                     (GL20/glLinkProgram pgm-id)
+        _ (except-gl-errors "@ let init-shaders glLinkProgram")
+        gl-link-status        (GL20/glGetProgrami pgm-id GL20/GL_LINK_STATUS)
+        _ (except-gl-errors "@ let init-shaders glGetProgram link status")
+        _                     (when (== gl-link-status GL11/GL_FALSE)
+                                (println "ERROR: Linking Shaders:")
+                                (println (GL20/glGetProgramInfoLog pgm-id 10000)))
+        _ (except-gl-errors "@ let before GetUniformLocation")
+        ]
+    (doseq [[i attribute-name] (map-indexed vector attribute-names)]
+      (GL20/glBindAttribLocation pgm-id i attribute-name))
+    pgm-id))

 (defn- init-shaders
   []
-  (let [[ok? vs-id] (load-shader (-> "shader.vs" clojure.java.io/resource slurp)  GL20/GL_VERTEX_SHADER)
-        _           (assert (== ok? GL11/GL_TRUE)) ;; something is really wrong if our vs is bad
-        [ok? fs-id] (load-shader (-> "shader.fs" clojure.java.io/resource slurp) GL20/GL_FRAGMENT_SHADER)]
+  (let [[ok? vs-id]    (load-shader (-> "shader.vs" clojure.java.io/resource slurp)  GL20/GL_VERTEX_SHADER)
+        _              (assert (== ok? GL11/GL_TRUE)) ;; something is really wrong if our vs is bad
+        [ok? fs-id]    (load-shader (-> "shader.fs" clojure.java.io/resource slurp) GL20/GL_FRAGMENT_SHADER)
+        _              (assert (== ok? GL11/GL_TRUE)) ;; something is really wrong if our fs is bad
+        [ok? fx-vs-id] (load-shader (-> "shader.vs" clojure.java.io/resource slurp) GL20/GL_VERTEX_SHADER)
+        _              (assert (== ok? GL11/GL_TRUE)) ;; something is really wrong if our fs is bad
+        [ok? fx-fs-id] (load-shader (-> "fx.fs" clojure.java.io/resource slurp) GL20/GL_FRAGMENT_SHADER)
+        _              (assert (== ok? GL11/GL_TRUE)) ;; something is really wrong if our fs is bad
+       ]
     (if (== ok? GL11/GL_TRUE)
-      (let [pgm-id                (GL20/glCreateProgram)
-            _ (except-gl-errors "@ let init-shaders glCreateProgram")
-            _                     (GL20/glAttachShader pgm-id vs-id)
-            _ (except-gl-errors "@ let init-shaders glAttachShader VS")
-            _                     (GL20/glAttachShader pgm-id fs-id)
-            _ (except-gl-errors "@ let init-shaders glAttachShader FS")
-            _                     (GL20/glLinkProgram pgm-id)
-            _ (except-gl-errors "@ let init-shaders glLinkProgram")
-            gl-link-status        (GL20/glGetProgrami pgm-id GL20/GL_LINK_STATUS)
-            _ (except-gl-errors "@ let init-shaders glGetProgram link status")
-            _                     (when (== gl-link-status GL11/GL_FALSE)
-                                    (println "ERROR: Linking Shaders:")
-                                    (println (GL20/glGetProgramInfoLog pgm-id 10000)))
-            _ (except-gl-errors "@ let before GetUniformLocation")
-            ]
-        (GL20/glBindAttribLocation pgm-id 0 "aVertexPosition")
-        (GL20/glBindAttribLocation pgm-id 1 "aTextureCoord")
-        pgm-id)
+      (let [pgm-id    (program-id vs-id fs-id "aVertexPosition" "aTextureCoord")
+            fb-pgm-id (program-id fx-vs-id fx-fs-id "aVertexPosition" "aTextureCoord")]
+        [pgm-id fb-pgm-id])
       (log/error "Error loading shaders"))))

 (defn ortho-matrix-buffer
@@ -625,11 +635,13 @@
     (reset! cursor-xy [x y]))
   (refresh! [_]
     (with-gl-context gl-lock
-      (let [{{:keys [vertices-vbo-id vertices-count texture-coords-vbo-id vao-id]} :buffers
-             {:keys [font-texture glyph-texture fg-texture bg-texture]} :textures
+      (let [{{:keys [vertices-vbo-id vertices-count texture-coords-vbo-id vao-id fbo-id]} :buffers
+             {:keys [font-texture glyph-texture fg-texture bg-texture fbo-texture]} :textures
              program-id :program-id
-             {:keys [u-MVMatrix u-PMatrix u-font u-glyphs u-fg u-bg font-size term-dim font-tex-dim
-                     font-texture-width font-texture-height glyph-tex-dim glyph-texture-width glyph-texture-height]} :uniforms
+             fb-program-id :fb-program-id
+             {:keys [u-MVMatrix u-PMatrix u-fb-MVMatrix u-fb-PMatrix u-font u-glyphs u-fg u-bg font-size term-dim font-tex-dim
+                     font-texture-width font-texture-height glyph-tex-dim glyph-texture-width glyph-texture-height
+                     u-fb]} :uniforms
              {:keys [^ByteBuffer glyph-image-data
                      ^ByteBuffer fg-image-data
                      ^ByteBuffer bg-image-data]} :data
@@ -691,6 +703,7 @@
         (.flip fg-image-data)
         (.flip bg-image-data)
         (try
+          (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER, fbo-id)
           (GL11/glViewport 0 0 screen-width screen-height)
           (except-gl-errors (str "glViewport " screen-width screen-height))
           (GL11/glClearColor 0.0 0.0 1.0 1.0)
@@ -721,9 +734,11 @@
           (except-gl-errors "texture coords bind")
           ; Setup font texture
           (GL13/glActiveTexture GL13/GL_TEXTURE0)
+          (except-gl-errors "font texture glActiveTexture")
           (GL11/glBindTexture GL11/GL_TEXTURE_2D font-texture)
-          (GL20/glUniform1i u-font, 0)
-          (except-gl-errors "font texture bind")
+          (except-gl-errors "font texture glBindTexture")
+          (GL20/glUniform1i u-font 0)
+          (except-gl-errors "font texture glUniform1i")
           ; Setup uniforms for glyph, fg, bg, textures
           (GL20/glUniform1i u-glyphs 1)
           (GL20/glUniform1i u-fg 2)
@@ -754,6 +769,33 @@
           (except-gl-errors "bg color glTexImage2D")
           (GL11/glDrawArrays GL11/GL_TRIANGLE_STRIP 0 vertices-count)
           (except-gl-errors "bg color glDrawArrays")
+          (GL20/glDisableVertexAttribArray 0)
+          (GL20/glDisableVertexAttribArray 1)
+
+
+          ;; Draw fbo to screen
+          (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER 0)
+          (GL11/glViewport 0 0 screen-width screen-height)
+          (GL11/glClearColor 1.0 0.0 0.0 1.0)
+          (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
+          (GL20/glUseProgram fb-program-id)
+          (GL20/glUniformMatrix4 u-fb-PMatrix false (ortho-matrix-buffer screen-width screen-height p-matrix-buffer))
+          (except-gl-errors (str "u-fb-PMatrix - glUniformMatrix4  " u-fb-PMatrix))
+          (GL20/glUniformMatrix4 u-fb-MVMatrix false (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0]
+                                                                          [screen-width screen-height 1.0]
+                                                                          mv-matrix-buffer))
+          (except-gl-errors (str "u-fb-MVMatrix - glUniformMatrix4  " u-fb-MVMatrix))
+          (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute)
+          (except-gl-errors "vbo bind - glEnableVertexAttribArray")
+          ;;; Setup uv buffer
+          (GL20/glEnableVertexAttribArray 1);texture-coords-vertex-attribute)
+          (except-gl-errors "texture coords bind")
+          ;;; Setup font texture
+          (GL13/glActiveTexture GL13/GL_TEXTURE0)
+          (GL11/glBindTexture GL11/GL_TEXTURE_2D fbo-texture)
+          (GL20/glUniform1i u-fb 0)
+          (GL11/glDrawArrays GL11/GL_TRIANGLE_STRIP 0 vertices-count)
+          ;;;; clean up
           (GL20/glDisableVertexAttribArray 0)
           (GL20/glDisableVertexAttribArray 1)
           (GL30/glBindVertexArray 0)
@@ -875,28 +917,47 @@
           glyph-texture    (with-gl-context gl-lock (xy-texture-id next-pow-2-columns next-pow-2-rows glyph-image-data))
           fg-texture       (with-gl-context gl-lock (texture-id next-pow-2-columns next-pow-2-rows fg-image-data))
           bg-texture       (with-gl-context gl-lock (texture-id next-pow-2-columns next-pow-2-rows bg-image-data))
-          [fbo-id fbo-texture-id]
-                           (with-gl-context gl-lock (fbo-texture next-pow-2-columns next-pow-2-rows))
+          [fbo-id fbo-texture]
+                           (with-gl-context gl-lock (fbo-texture screen-width screen-height))
           ; init shaders
-          pgm-id ^long                    (with-gl-context gl-lock (init-shaders))
+          [pgm-id
+           fb-pgm-id]      (with-gl-context gl-lock (init-shaders))
           pos-vertex-attribute            (with-gl-context gl-lock (GL20/glGetAttribLocation pgm-id "aVertexPosition"))
           texture-coords-vertex-attribute (with-gl-context gl-lock (GL20/glGetAttribLocation pgm-id "aTextureCoord"))
+          fb-pos-vertex-attribute            (with-gl-context gl-lock (GL20/glGetAttribLocation fb-pgm-id "aVertexPosition"))
+          fb-texture-coords-vertex-attribute (with-gl-context gl-lock (GL20/glGetAttribLocation fb-pgm-id "aTextureCoord"))

           ;; We just need one vertex buffer, a texture-mapped quad will suffice for drawing the terminal.
           {:keys [vertices-vbo-id
                   vertices-count
                   texture-coords-vbo-id
                   vao-id]}          (with-gl-context gl-lock (init-buffers))
-          u-MVMatrix                (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uMVMatrix"))
-          u-PMatrix                 (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uPMatrix"))
-          u-font                    (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uFont"))
-          u-glyphs                  (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uGlyphs"))
-          u-fg                      (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uFg"))
-          u-bg                      (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "uBg"))
-          font-size                 (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "fontSize"))
-          term-dim                  (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "termDimensions"))
-          font-tex-dim              (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "fontTextureDimensions"))
-          glyph-tex-dim             (with-gl-context gl-lock (GL20/glGetUniformLocation pgm-id "glyphTextureDimensions"))
+          [glyph-tex-dim
+           u-MVMatrix
+           u-PMatrix
+           u-font
+           u-glyphs
+           u-fg
+           u-bg
+           font-size
+           term-dim
+           font-tex-dim]  (with-gl-context gl-lock (mapv #(GL20/glGetUniformLocation pgm-id %)
+                                                         ["glyphTextureDimensions"
+                                                          "uMVMatrix"
+                                                          "uPMatrix"
+                                                          "uFont"
+                                                          "uGlyphs"
+                                                          "uFg"
+                                                          "uBg"
+                                                          "fontSize"
+                                                          "termDimensions"
+                                                          "fontTextureDimensions"]))
+           [u-fb
+            u-fb-MVMatrix
+            u-fb-PMatrix] (with-gl-context gl-lock (mapv #(GL20/glGetUniformLocation fb-pgm-id %)
+                                                         ["uFb"
+                                                          "uMVMatrix"
+                                                          "uPMatrix"]))
           terminal
           ;; Create and return terminal
           (OpenGlTerminal. columns
@@ -918,16 +979,24 @@
                             :buffers {:vertices-vbo-id vertices-vbo-id
                                       :vertices-count vertices-count
                                       :texture-coords-vbo-id texture-coords-vbo-id
-                                      :vao-id vao-id}
+                                      :vao-id vao-id
+                                      :fbo-id fbo-id}
                             :textures {:glyph-texture glyph-texture
                                        :font-texture font-texture
                                        :fg-texture fg-texture
-                                       :bg-texture bg-texture}
+                                       :bg-texture bg-texture
+                                       :fbo-texture fbo-texture}
                             :attributes {:pos-vertex-attribute pos-vertex-attribute
-                                         :texture-coords-vertex-attribute texture-coords-vertex-attribute}
+                                         :texture-coords-vertex-attribute texture-coords-vertex-attribute
+                                         :fb-pos-vertex-attribute fb-pos-vertex-attribute
+                                         :fb-texture-coords-vertex-attribute fb-texture-coords-vertex-attribute
+}
                             :program-id pgm-id
+                            :fb-program-id fb-pgm-id
                             :uniforms {:u-MVMatrix u-MVMatrix
                                        :u-PMatrix u-PMatrix
+                                       :u-fb-MVMatrix u-fb-MVMatrix
+                                       :u-fb-PMatrix u-fb-PMatrix
                                        :u-font u-font
                                        :u-glyphs u-glyphs
                                        :u-fg u-fg
@@ -939,7 +1008,8 @@
                                        :font-texture-height font-texture-height
                                        :glyph-tex-dim glyph-tex-dim
                                        :glyph-texture-width glyph-texture-width
-                                       :glyph-texture-height glyph-texture-height}
+                                       :glyph-texture-height glyph-texture-height
+                                       :u-fb u-fb}
                             :data {:glyph-image-data glyph-image-data
                                    :fg-image-data fg-image-data
                                    :bg-image-data bg-image-data}}


Update docstring for 'clean'. Fixes #103.

--- src/leiningen/clean.clj
+++ src/leiningen/clean.clj
@@ -4,7 +4,7 @@
         [leiningen.util.file :only [delete-file-recursively]]))

 (defn clean
-  "Remove compiled files and dependencies from project."
+  "Remove compiled artifacts and jars from project."
   [project]
   (println "Cleaning up.")
   (doseq [f [(get-jar-filename project)


update for field type

update for field type

--- src/graphql_clj/parser.clj
+++ src/graphql_clj/parser.clj
@@ -198,13 +198,14 @@
   [object-type field-selection]
   (log/debug (format "get-field-type-from-object-type: object-type: %s." object-type))
   (log/debug (format "get-field-type-from-object-type: field-selection: %s." field-selection))
-  (let [object-name (get-selection-object-name field-selection)
-        _ (log/debug "object-name: " object-name)
+  (let [field-name (get-selection-object-name field-selection)
+        _ (log/debug "field-name: " field-name)
         _ (log/debug "object: " (get-in object-type [:fields]))
-        type (get-in object-type [:fields (keyword object-name) :type])]
-    (if (map? type)
-      type
-      (get-type-meta type))))
+        type (get-in object-type [:fields (keyword field-name) :type])]
+    (cond
+      (map? type) type
+      (keyword? type) (get-type-meta type)
+      (nil? type) (throw (ex-info (format "Cannot find field type (%s) in object(%s)." field-name object-type) {})))))

 (defn resolve-field-on-object
   "FIXME"


Make head a partial in base layout.

Make head a partial in base layout.

--- src/incise/layouts/impl/base.clj
+++ src/incise/layouts/impl/base.clj
@@ -13,6 +13,29 @@
                     [element :refer :all]))
   (:import [java.io FileNotFoundException]))

+(defn- attempt-link-to-asset
+  "Return nil if the asset is not found othewise return a url for the asset."
+  [asset-name]
+  (try
+    (link-to-asset asset-name nil)
+    (catch FileNotFoundException _ nil)))
+
+(defn stylesheets []
+  [(attempt-link-to-asset "stylesheets/app.css.stefon")])
+
+(defn javascripts []
+  [(attempt-link-to-asset "javascripts/app.js.stefon")])
+
+(defpartial head
+  "The default head."
+  [{:keys [site-title]} {:keys [title]}]
+  [:head
+   (when (or site-title title)
+     [:title (s/join " - " (keep identity [site-title title]))])
+   [:meta {:charset "UTF-8"}]
+   [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
+   (apply include-css (keep identity (stylesheets)))])
+
 (defpartial header "A blank header" [] nil)

 (defpartial content
@@ -26,36 +49,17 @@
 (defpartial footer
   "A very basic footer crediting this project."
   [{:keys [contacts author]} _]
-  (html
-    [:footer
-     [:p
-      "This website was "
-      (link-to "https://github.com/RyanMcG/incise" "incised") \.]]))
-
-(defn- attempt-link-to-asset
-  "Return nil if the asset is not found othewise return a url for the asset."
-  [asset-name]
-  (try
-    (link-to-asset asset-name nil)
-    (catch FileNotFoundException _ nil)))
-
-(defn stylesheets []
-  [(attempt-link-to-asset "stylesheets/app.css.stefon")])
-
-(defn javascripts []
-  [(attempt-link-to-asset "javascripts/app.js.stefon")])
+  [:footer
+   [:p
+    "This website was "
+    (link-to "https://github.com/RyanMcG/incise" "incised") \.]])

 (deflayout base
   "The default page/post layout."
-  [{:keys [site-title]} {:keys [title]}]
+  []
   (with-base-url (when-not (conf/serving?) (str \/ (conf/get :uri-root)))
     (html5
-      [:head
-       (when (or site-title title)
-         [:title (s/join " - " (keep identity [site-title title]))])
-       [:meta {:charset "UTF-8"}]
-       [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
-       (apply include-css (remove nil? (stylesheets)))]
+      (head)
       [:body#page
        [:div.container
         (header)


Eval arg-resolvers in analyse-dispatch-table

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -251,7 +251,8 @@
             context          (:context (meta pathvec))
             arglist          (first (:arglists metadata))
             non-route-params (remove (set route-params) arglist)
-            arg-resolvers    (:arg-resolvers metadata)
+            arg-resolvers    (binding [*ns* ns]
+                               (eval (:arg-resolvers metadata)))
             schema           (:schema metadata)
             handler (cond->
                       {:middleware-sym   mw-sym
@@ -436,8 +437,7 @@

                   resolve-args (arglist-resolver
                                  arglist
-                                 (resolvers-for arglist
-                                   (eval (:arg-resolvers metadata)))
+                                 (resolvers-for arglist arg-resolvers)
                                  route-params)

                   mw (eval (get middleware middleware-sym))


TESTS BROKEN: Removed future call in fetch-code.

--- src/loudmoauth/core.clj
+++ src/loudmoauth/core.clj
@@ -10,6 +10,7 @@
 ;TODO - Deal with missing :redirect-uri key, if that is possible?
 ;TODO - Go over doc strings one more time.
 ;TODO - Uniform keys all over.
+;TODO - Crap, we need to let the user authenticate. Don't put the get auth code on a future.

 (def code-chan (a/chan))

@@ -64,7 +65,7 @@
 (defn fetch-code
   "Fetch code to be used in call to fetch tokens."
   [astate]
-  (future (client/get (:auth-url astate)))
+  (client/get (:auth-url astate))
   (assoc astate :code (a/<!! code-chan)))

 (defn string-to-base64-string


Loads simple mode addon on editor init

Loads simple mode addon on editor init

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -684,6 +684,7 @@
                       (load/js "core/node_modules/codemirror/addon/selection/active-line.js" :sync)
                       ;; TODO: use addon/mode/overlay.js
                       (load/js "core/node_modules/codemirror_addons/overlay.js" :sync)
+                      (load/js "core/node_modules/codemirror/addon/mode/simple.js" :sync)
                       (load/js "core/node_modules/codemirror/addon/scroll/scrollpastend.js" :sync)
                       (doseq [file (files/ls "core/node_modules/codemirror/addon/fold")
                               :when (= (files/ext file) "js")]


Made basic outline of swagger1

Made basic outline of swagger1

--- src/ardoq/swagger/swagger.clj
+++ src/ardoq/swagger/swagger.clj
@@ -36,11 +36,9 @@
   (let [name (if (s/blank? title)
                (or (:title info) base-url)
                title)]
-    (if-let [workspace (common/find-existing-resource client name #(api/map->Workspace {}))]
-      workspace
-      (-> (api/->Workspace name (tpl/render-resource "infoTemplate.tpl" (assoc info :workspaceName name :baseUrl base-url)) (str (:_id model)))
-          (assoc :views ["swimlane" "sequence" "integrations" "componenttree" "relationships" "tableview" "tagscape" "reader" "processflow"])
-          (api/create  client)))))
+    (-> (api/->Workspace name (tpl/render-resource "infoTemplate.tpl" (assoc info :workspaceName name :baseUrl base-url)) (str (:_id model)))
+        (assoc :views ["swimlane" "sequence" "integrations" "componenttree" "relationships" "tableview" "tagscape" "reader" "processflow"])
+        (api/create  client))))

 (defn get-resource-listing [url]
   (let [{:keys [status body] :as resp} (http/get (str (io/as-url url)) {:headers *custom-headers* :insecure? true})]
@@ -151,21 +149,52 @@
         (urly/relative? u) (str (.mutatePath (urly/url-like url) (urly/path-of u)))))
     url))

+(defn delete-and-create-refs [client workspace operations models]
+  (doseq [ref (:references workspace)]
+    (api/delete (api/map->Reference ref) client))
+  (doall (create-refs client operations models)))
+
+(defn update-resources [client workspace url model resource]
+  "random return")
+
+(defn update-model [client url workspace model]
+  "random return")
+
+(defn update-resources [client url workspace model models]
+  "random return")
+
+(defn update-swagger [workspace client resource-listing url model]
+  (let [resources (doall (partial update-resources client workspace url model) (:apis resource-listing))
+        models (doall (-> (apply merge (map (partial update-model client url workspace model) resources))))
+        operations (doall (mapcat (partial update-operations client url workspace model models) resources))
+        refs (delete-and-create-refs client workspace operations models)
+        all {:workspace workspace
+                   :resources resources
+                   :models models
+                   :operations operations
+                   :refs refs}]
+    (common/find-or-create-fields client model)
+    (println "Done updating Swagger")
+    (str (:_id workspace))))
+
 (defn import-swagger [client resource-listing base-url name headers]
   (binding [*custom-headers* headers]
     (let [url (resolve-url resource-listing base-url)
-          model (common/find-or-create-model client "Swagger")
-          workspace (create-workspace client url base-url name model resource-listing)
-          resources (doall (map (partial create-resource client workspace url model) (:apis resource-listing)))
-          models (doall (-> (apply merge (map (partial create-models client url workspace model) resources))
-                            (common/save-models client)))
-          operations (doall (mapcat (partial create-api client url workspace model models) resources))
-          refs (doall (create-refs client operations models))
-          all {:workspace workspace
-               :resources resources
-               :models models
-               :operations operations
-               :refs refs}]
-      (common/find-or-create-fields client model)
-      (println "Imported " (count resources) " resources, " (count models) " json schemas," (count operations) " operations and " (count refs) " refs.")
-      (str (:_id workspace)))))
+          model (common/find-or-create-model client "Swagger")]
+      (when-not (some-> (common/find-existing-resource client (if (s/blank? name) (or (:title resource-listing) base-url) name) #(api/map->Workspace {}))
+                        (api/find-aggregated client)
+                        (update-swagger client resource-listing url model))
+        (let [workspace (create-workspace client url base-url name model resource-listing)
+              resources (doall (map (partial create-resource client workspace url model) (:apis resource-listing)))
+              models (doall (-> (apply merge (map (partial create-models client url workspace model) resources))
+                                (common/save-models client)))
+              operations (doall (mapcat (partial create-api client url workspace model models) resources))
+              refs (doall (create-refs client operations models))
+              all {:workspace workspace
+                   :resources resources
+                   :models models
+                   :operations operations
+                   :refs refs}]
+          (common/find-or-create-fields client model)
+          (println "Imported " (count resources) " resources, " (count models) " json schemas," (count operations) " operations and " (count refs) " refs.")
+          (str (:_id workspace)))))))


The library sig has to start with lower case

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -18,7 +18,7 @@

 (def library-signature-regexp
   "Validation regexp for library signatures"
-  #"^DS\d{5,}$")
+  #"^ds\d{5,}$")

 (defn multi-volume?
   "Return true if this production has multiple volumes"


update load-template

update load-template

--- src/misaki/template.clj
+++ src/misaki/template.clj
@@ -4,7 +4,8 @@
     ;[misaki transform config]
     [misaki evaluator config]
     [clojure.core.incubator :only [-?>]])
-  (:require [clojure.string :as str])
+  (:require [clojure.string :as str]
+            [clojure.java.io :as io])
   (:import [java.io File]))

@@ -46,31 +47,32 @@
         contents (with-meta contents option)]
     (with-meta (f contents) option)))

+; =load-template-data
+(defn- load-template-data
+  "Load template data(String) and option."
+  [#^File file]
+  (let [data (slurp file)
+        option (parse-template-option data)
+        result (list [data option])]
+    (if-let [parent (-?> option :layout make-layout-filename io/file)]
+      (concat (load-template-data parent) result)
+      result)))
+
 ; =load-template
 (defn load-template
-  "Load template file, and transform to function.
+  "Load template file, and evaluate as function.
   Template options are contained as meta data.
-
+
   If `allow-layout?` option is specified, you can select whether evaluate layout or not."
   ([#^File file] (load-template file true))
   ([#^File file allow-layout?]
-   (let [data   (slurp file)
-         option (parse-template-option data)]
-
-     (if-let [layout-filename (-?> option :layout make-layout-filename)]
-       (let [; at first, evaluate parent layout
-             ; parent layout must be evaluated if layout is not allowded
-             parent-layout-fn (load-template layout-filename)
-             ; second, evaluate this layout
-             ;layout-fn (transform data)]
-             layout-fn (evaluate data)]
-         (if allow-layout?
-           (with-meta
-             #(apply-template parent-layout-fn
-                (apply-template layout-fn %))
-             (merge (meta parent-layout-fn) option))
-           (with-meta layout-fn
-                      (merge (meta parent-layout-fn) option))))
-       ;(with-meta (transform data) option)))))
-       (with-meta (evaluate data) option)))))
-
+   (reduce
+     (fn [parent-fn [template-data option]]
+       (let [template-fn (evaluate template-data)]
+         (with-meta
+           (if (or (nil? parent-fn) (not allow-layout?))
+             template-fn
+             #(apply-template parent-fn (apply-template template-fn %)))
+           (merge (meta parent-fn) option))))
+     nil
+     (load-template-data file))))


all-clicks has been calculated

all-clicks has been calculated

--- src/mljalfa/znet/cg.clj
+++ src/mljalfa/znet/cg.clj
@@ -7,6 +7,7 @@
     [clojure.set :as cset]))

 (def dir "/Users/questmac/public/db/click-logs/")
+(def dir-kopet "/Users/questmac/public/db/resources/")

 (defn next-day
   [jdate]
@@ -20,6 +21,19 @@
        (cs/split-lines)
        (filter #(pos? (count %)))
        (pmap json/read-json)))
+
+(defn open-log-kopet
+  [fname]
+  (->> (str dir-kopet fname)
+       (slurp)
+       (cs/split-lines)
+       (filter #(pos? (count %)))
+       (pmap json/read-json)))
+
+(defn open-file
+  [fname]
+  (->> (str "resources/relevant/" fname ".edn")
+       slurp read-string))

 (defonce cdb (-> {:bucket "znetroyalty"
                   :uris   ["http://127.0.0.1:8091/pools"]}
@@ -53,6 +67,21 @@
         (do (println strday)
             (recur (next-day sday) (merge-with #(merge-with + %1 %2) res resi)))))))

+(defn store-user-log-kopet
+  [start-date end-date]
+  (loop [[sday strday] (next-day start-date) res {}]
+    (if (= strday end-date)
+      (do (spit "resources/kopet-data.edn" res)
+          (->> (take 100 res)
+               (into {})))
+      (let [resi (time (loop [[x & xs] (open-log-kopet (str "click-log-" strday)) resi {}]
+                         (if x
+                           (recur xs (->> #(merge-with + % {(first (:content-id x)) 1})
+                                          (update-in resi [(:user-id x)])))
+                           resi)))]
+        (do (println strday)
+            (recur (next-day sday) (merge-with #(merge-with + %1 %2) res resi)))))))
+
 (defn get-top-parent
   [content-id]
   (let [{:keys [cg-id]} (cc/get-json cdb (str "content-" content-id))]
@@ -91,12 +120,14 @@

 (defn user->member
   [fname]
-  (let [raw (read-string (slurp "resources/selected.edn"))
+  (let [raw (read-string (slurp "resources/avi-data.edn"))
         mapping (read-string (slurp "resources/lala.edn"))
-        sraw (set (map first (map keys raw)))]
-    (loop [[[k v] & xs] (seq mapping) res {}]
+        sraw (set (keys raw))]
+    (loop [[[k v] & xs] (seq mapping) res {} i 0]
       (if k
-        (recur xs (merge res {(first (keep sraw k)) v}))
+        (do (when (== 0 (rem i 10000))
+              (println i))
+            (recur xs (merge res {(first (keep sraw k)) v}) (inc i)))
         (do (spit (str "resources/" fname ".edn") res)
             (take 20 res))))))

@@ -162,7 +193,7 @@
           (cc/set-json cdb (keyword (:key (cbkey "content-group" id)))
                        (merge from-db v))
           (cc/set-json cdb (keyword (:key (cbkey "content-group" id)))
-                       (merge v {:ctype "content-group"
+                       (merge v {:ctype    "content-group"
                                  :contents []}))))
       (println (:id v))
       (recur vs))))
@@ -177,14 +208,63 @@
             (cc/get-json cdb (keyword (:key (cbkey "content" id)))
                          (merge from-db v))
             (cc/get-json cdb (keyword (:key (cbkey "content" id)))
-                         (merge v {:ctype "content"
+                         (merge v {:ctype  "content"
                                    :tutors []
-                                   :hits {}}))))
+                                   :hits   {}}))))
         (println (:id v))
         (recur vs)))))

-
-
-
-
-
+(defn convert-avi-data
+  [fname]
+  (let [convert (-> "resources/converts.edn" slurp read-string)]
+    (->> "resources/avi-data.edn"
+         slurp read-string
+         (keep #(if-let [k (convert (key %))]
+                 {k (val %)}))
+         (into [])
+         (spit (str "resources/" fname ".edn")))))
+
+(defn convert-kopet-data
+  []
+  (let [raw (open-file "kopet-data")]
+    (loop [[[k v] & vs] (seq raw) res []]
+      (if k
+        (recur vs (conj res {k (->> (map #(vector (str (key %)) (val %)) v)
+                                    (into {}))}))
+        (do (spit "resources/relevant/kopet-data-bagus.edn" res)
+            (take 20 res))))))
+
+(defn agglomerate-logs
+  [fname]
+  (let [raw1 (reduce merge (open-file "kopet-data-bagus"))
+        raw2 (reduce merge (open-file "avi-data-member"))
+        result (merge-with #(merge-with + %1 %2) raw1 raw2)]
+    (spit (str "resources/relevant/" fname ".edn") result)
+    (take 50 result)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


Temp workaround for channel (requires #)

--- src/mokkameister/slack.clj
+++ src/mokkameister/slack.clj
@@ -15,7 +15,7 @@
   (let [payload {:text message
                  :username username
                  :icon_emoji emoji
-                 :channel channel}]
+                 :channel (str "#" channel)}]
     (client/post slack-url {:content-type :json
                             :form-params payload})))


starting work on STARTTLS support

starting work on STARTTLS support

--- src/neveragain/core.clj
+++ src/neveragain/core.clj
@@ -4,8 +4,9 @@
 		(neveragain
 			[common :refer :all]
 			[settings :as settings]
-			rfc))
+			rfc tls))
 	(:import
+		(javax.net.ssl SSLSocket)
 		(java.net ServerSocket InetAddress)
  		(java.util.concurrent Executors)
 		(java.io PrintWriter InputStreamReader BufferedReader)))
@@ -30,6 +31,7 @@

 (def enabled-extensions [
 	neveragain.rfc/extension-description
+	neveragain.tls/extension-description
 ])

 (def verb-handler-map (rewrite-ehlo (reduce
@@ -58,11 +60,13 @@
 	; seems to work. Every function is supposed to return envl, and in
 	; this way modify session state. If a handler function retuns nil instead we
 	; take that to mean this sessions has ended.
-	(loop [envl {}]
-		(let [msg (.readLine (:in conn))]
-			(let [modified-envl (respond conn msg envl)]
-				(if-not (= modified-envl nil)
-					(recur modified-envl))))))
+	(loop [envl {} inner-conn conn]
+		(let [msg (.readLine (:in inner-conn))]
+			(let [response (respond inner-conn msg envl)]
+				(cond
+					(= (type response) SSLSocket) (recur envl response)
+					(= response nil) nil
+					:else (recur response inner-conn))))))

 (defn serve-forever [port-number thread-count]
 	(let [serv-socket (ServerSocket. port-number)]


Add notification email tests.

Add notification email tests.

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -246,6 +246,15 @@
                                  :html (slurp inline-html-file)})))
   (send-email-from-file email-setup "./hiccup.html")

+  (def notification-request (clojure.walk/keywordize-keys (json/decode (slurp "./opt/samples/notifications/post-mention.json"))))
+  (mailer/send-notification (assoc notification-request :to "change@me.com"))
+
+  (def notification-request (clojure.walk/keywordize-keys (json/decode (slurp "./opt/samples/notifications/comment.json"))))
+  (mailer/send-notification (assoc notification-request :to "change@me.com"))
+
+  (def notification-request (clojure.walk/keywordize-keys (json/decode (slurp "./opt/samples/notifications/comment-mention.json"))))
+  (mailer/send-notification (assoc notification-request :to "change@me.com"))
+
   (def share-request (clojure.walk/keywordize-keys (json/decode (slurp "./opt/samples/share/bago.json"))))
   (mailer/send-entry (merge share-request {
                        :to ["change@me.com"]


Improve perf of `jobs-ready`

Improve perf of `jobs-ready`

Prior to this commit `status/jobs-ready` was taking 20s to find the
jobs that are ready to run.  This commit makes the query take 3s to
find the same data.

The general algorithm does the following:

1. Find all jobs that are not finished/aborted/failed yet, i.e. could
   be run if their dependencies were all satisfied
2. Subtract the jobs whose dependencies are not satisfied

However, prior to this commit, step #2 above was searching the entire
database for jobs whose dependencies are not satisfied, it wasn't
constraining the search space to only those jobs that were part of
step #1 above.  This commit makes step #2 only consider jobs from
step #1 from the start, which greatly cuts down the search space.

This improves the inter-job delays we're seing between jobs.  This
cost is particularly high if the workers are waiting 20 sec. in
between 1 sec jobs, which this commit should at least partially
ameliorate.

--- src/overseer/status.clj
+++ src/overseer/status.clj
@@ -33,14 +33,18 @@
    Works by finding all jobs that are not yet done, and subtracting the
    jobs who dependencies are not yet ready."
   [db]
-  (set/difference
-    (jobs-unfinished db)
-    (->> (d/q '[:find ?jid
-                :where
-                [?j :job/dep ?dj]
-                [?dj :job/status ?djs]
-                [(not= :finished ?djs)]
-                [?j :job/id ?jid]]
-              db)
-         (map first)
-         (into #{}))))
+  (let [unfinished (jobs-unfinished db)]
+    (set/difference
+      unfinished
+      (->> (d/q '[:find ?jid
+                  :in $ [?unfinished-jids ...]
+                  :where
+                  [?j :job/id ?unfinished-jids]
+                  [?j :job/id ?jid]
+                  [?j :job/dep ?dj]
+                  [?dj :job/status ?djs]
+                  [(not= :finished ?djs)]]
+                db
+                unfinished)
+           (map first)
+           (into #{})))))


ignore more events

ignore more events

--- src-cljs/frontend/analytics.cljs
+++ src-cljs/frontend/analytics.cljs
@@ -32,7 +32,10 @@
                           :camera-nudged-right
                           :camera-nudged-left
                           :camera-nudged-down
-                          :camera-nudged-up})
+                          :camera-nudged-up
+                          :text-layer-edited
+                          :layer-ui-id-edited
+                          :layer-ui-target-edited})

 (defn track-control [event state]
   (when-not (contains? controls-blacklist event)


Improve component decoupling: event list

--- src-cljs/photon/ui/frontend.cljs
+++ src-cljs/photon/ui/frontend.cljs
@@ -223,31 +223,39 @@
                   (clj->str event)))))))))))

 (defn event-list [params owner]
-  (reify
-    om/IRender
-    (render [_]
-      (apply dom/ul
-          nil
-          (map #(om/build event-list-item {:data (:data params)
-                                           :event %})
-               (:events params))))))
-
-(defn widget-stream [data owner]
-  (reify
+  (let [fn-update
+        (fn [stream-name]
+          (go (let [response
+                    (:body (<! (client/get
+                                (str "/stream-contents/"
+                                     stream-name))))]
+                (om/update-state!
+                 owner
+                 #(assoc % :events (:results response))))))]
+   (reify
     om/IInitState
     (init-state [this]
       {:events []})
-    om/IDidMount
-    (did-mount [this]
-      (go (let [response
-                (:body (<! (client/get
-                            (str "/stream/" (:stream data)))))]
-            (om/update-state!
-             owner
-             #(assoc % :events (:results response))))))
     om/IDidUpdate
     (did-update [_ _ _]
       (dorun (map #(.highlightBlock js/hljs %) ($ "code"))))
+    om/IWillReceiveProps
+    (will-receive-props [this next-props]
+      (om/update-state! owner (fn [_] {:events []}))
+      (fn-update (:stream next-props)))
+    om/IDidMount
+    (did-mount [this]
+      (fn-update (:stream params)))
+    om/IRenderState
+    (render-state [_ state]
+      (apply dom/ul
+          nil
+          (map #(om/build event-list-item {:data (:data params)
+                                           :event %})
+               (:events state)))))))
+
+(defn widget-stream [data owner]
+  (reify
     om/IRenderState
     (render-state [_ state]
       (.log js/console (:current data))
@@ -256,8 +264,8 @@
         (dom/h2
           nil
           (str "Events: " (:stream data)))
-        (om/build event-list {:data data
-                              :events (:events state)})))))
+        (om/build event-list {:stream (:stream data)
+                              :data data})))))

 (defn full-page [data owner]
   (reify
@@ -268,7 +276,7 @@
         (let [{:keys [ws-channel]} (<! (ws-ch "ws://localhost:3000/ws"))
               {:keys [message]} (<! ws-channel)]
           (om/update! data :chord-test message)
-          (js/console.log "Got message from server:" (pr-str message)))))
+          (.log js/console "Got message from server:" (pr-str message)))))
     om/IRender
     (render [_]
       (dom/div


Function for prediction

Function for prediction

Retrieve the sum of frequencies and differences of each item in the maps
returned by
the slope-one function. Predict rating of post by rating of another user
who rated it.

--- src/blog/routes/slope-one.clj
+++ src/blog/routes/slope-one.clj
@@ -38,5 +38,23 @@

+(defn predict
+  "retrieve the sum of frequencies and differences of each item in the maps returned by
+   the slope-one function"
+  [{:keys [differences freqs]
+    :as model}
+   preferences
+   item]
+  (let [get-rating-fn (fn [[num-acc denom-acc]
+                           [i rating]]
+                        (let [freqs-ji (get-in freqs [item i])]
+                          [(+ num-acc
+                              (* (+ (get-in differences [item i])
+                                    rating)
+                                 freqs-ji))
+                           (+ denom-acc freqs-ji)]))]
+    (->> preferences
+         (filter #(not= (first %) item))
+         (reduce get-rating-fn [0 0])
+         (apply /))))

-


Revert to starting swank conditionally, when the CIRCLE_SWANK env variable is set

--- backend/src/circle/init.clj
+++ backend/src/circle/init.clj
@@ -20,7 +20,8 @@
   (delay
    (try
      (circle.logging/init)
-     (circle.swank/init)
+     (when (System/getenv "CIRCLE_SWANK")
+       (circle.swank/init))
      (circle.db/init)
      (circle.repl/init)
      (println (java.util.Date.))


cleaned up som function names

cleaned up som function names

--- test/simple_symbolic_regression_clojure/gp_test.clj
+++ test/simple_symbolic_regression_clojure/gp_test.clj
@@ -198,9 +198,13 @@
   (repeatedly pop-size constructor-fn))

+(def token-generator
+  [#(rand-int 100) :x :+ :- :* :÷])
+
+
 (fact "we can make a population of random individuals"
-  (let [dude (fn [] (random-individual [#(rand-int 100) :x :+ :- :* :÷] 20))]
-    (count (random-population 100 dude)) => 100))
+  (let [random-dude (fn [] (random-individual token-generator 20))]
+    (count (random-population 100 random-dude)) => 100))

 (def sine-rubrics
@@ -215,9 +219,9 @@

 (fact "we can score an Individual with a Rubric (or set)"
-  (let [dude (random-individual ['(rand-int 100) :x :+ :- :* :÷] 20)]
-    (:score dude) => nil
-    (> (:score (score-using-rubrics dude sine-rubrics)) 0) => true
+  (let [random-dude (fn [] (random-individual token-generator 20))]
+    (:score (random-dude)) => nil
+    (> (:score (score-using-rubrics (random-dude) sine-rubrics)) 0) => true
     ))

@@ -228,9 +232,21 @@

 (fact "we can score a whole population with `score-population`"
-  (let [dude (fn [] (random-individual [#(rand-int 100) :x :+ :- :* :÷] 20))]
-    (apply min (map :score (score-population (random-population 100 dude) sine-rubrics)))) => 100)
-
+  (let [random-dude (fn [] (random-individual token-generator 20))]
+    (not-any? nil?
+      (map
+        :score
+        (score-population (random-population 100 random-dude)
+          sine-rubrics)))) => true)
+
+
+(defn new-babies
+  "produce `n` new Individuals by applying `operator` to `population` given `token-generator`"
+  [n operator population token-generator]
+  )
+
+; (fact "we can produce a pile of new babies from a population"
+;   (new-babies ))

 ; (defn population-step
 ;   []


Remove the annoying flicker when a position is automatically moved to prevent screen edge clipping. Also now fades on (but not off).

--- src/re_com/popover.cljs
+++ src/re_com/popover.cljs
@@ -204,6 +204,23 @@
     :left   (if p-width (- (- p-width 25) position-offset) p-width)
     :above  (if p-height (- (- p-height 25) position-offset) p-height)))

+(defn popover-clipping
+  [node]
+  (let [viewport-width  (.-innerWidth   js/window)    ;; Width  (in pixels) of the browser window viewport including, if rendered, the vertical   scrollbar.
+        viewport-height (.-innerHeight  js/window)    ;; Height (in pixels) of the browser window viewport including, if rendered, the horizontal scrollbar.
+        bounding-rect   (.getBoundingClientRect node)
+        left            (.-left   bounding-rect)
+        right           (.-right  bounding-rect)
+        top             (.-top    bounding-rect)
+        bottom          (.-bottom bounding-rect)
+        clip-left       (when (< left 0) (- left))
+        clip-right      (when (> right viewport-width) (- right viewport-width))
+        clip-top        (when (< top 0) (- top))
+        clip-bottom     (when (> bottom viewport-height) (- bottom viewport-height))]
+    #_(when (or (some? clip-left) (some? clip-right) (some? clip-top) (some? clip-bottom))  ;; Return full clipping details (or nil if not clipped)
+        {:left clip-left :right clip-right :top clip-top :bottom clip-bottom})
+    (or (some? clip-left) (some? clip-right) (some? clip-top) (some? clip-bottom))))        ;; Return boolean
+
 (def popover-border-args-desc
   [{:name :children        :required true                        :type "vector"           :validate-fn sequential?       :description "a vector of component markups"}
    {:name :position        :required true                        :type "keyword atom"     :validate-fn position?         :description [:span "relative to this anchor. One of " position-options-list]}
@@ -227,7 +244,8 @@
       :as args}]
   {:pre [(validate-args-macro popover-border-args-desc args "popover-border")]}
   (let [pop-id                  (gensym "popover-")
-        rendered-once           (reagent/atom false)
+        rendered-once           (reagent/atom false)        ;; The initial render is off screen because rendering it in place does not render at final width, and we need to measure it to be able to place it properly
+        ready-to-show?          (reagent/atom false)        ;; This is used by the optimal position code to avoid briefly seeing it in its intended position before quickly moving to the optimal position
         p-width                 (reagent/atom 0)
         p-height                (reagent/atom 0)
         pop-offset              (reagent/atom 0)
@@ -239,22 +257,7 @@
                                     (reset! p-width    (if popover-elem (next-even-integer (.-clientWidth  popover-elem)) 0)) ;; next-even-integer required to avoid wiggling popovers (width/height appears to prefer being even and toggles without this call)
                                     (reset! p-height   (if popover-elem (next-even-integer (.-clientHeight popover-elem)) 0))
                                     (reset! pop-offset (calc-pop-offset arrow-pos position-offset @p-width @p-height))
-                                    [orientation grey-arrow?]))
-        popover-clipping        (fn [node]
-                                  (let [viewport-width  (.-innerWidth   js/window)    ;; Width  (in pixels) of the browser window viewport including, if rendered, the vertical   scrollbar.
-                                        viewport-height (.-innerHeight  js/window)    ;; Height (in pixels) of the browser window viewport including, if rendered, the horizontal scrollbar.
-                                        bounding-rect   (.getBoundingClientRect node)
-                                        left            (.-left   bounding-rect)
-                                        right           (.-right  bounding-rect)
-                                        top             (.-top    bounding-rect)
-                                        bottom          (.-bottom bounding-rect)
-                                        clip-left       (when (< left 0) (- left))
-                                        clip-right      (when (> right viewport-width) (- right viewport-width))
-                                        clip-top        (when (< top 0) (- top))
-                                        clip-bottom     (when (> bottom viewport-height) (- bottom viewport-height))]
-                                    #_(when (or (some? clip-left) (some? clip-right) (some? clip-top) (some? clip-bottom)) ;; Return full clipping details (or nil if not clipped)
-                                      {:left clip-left :right clip-right :top clip-top :bottom clip-bottom})
-                                    (or (some? clip-left) (some? clip-right) (some? clip-top) (some? clip-bottom))))] ;; Return boolean
+                                    [orientation grey-arrow?]))]
     (reagent/create-class
       {:display-name "popover-border"

@@ -266,11 +269,12 @@
        (fn [this]
          (let [pop-border-node (reagent/dom-node this)
                clipped?        (popover-clipping pop-border-node)
-               anchor-node     (.-parentNode (.-parentNode (.-parentNode pop-border-node)))] ;; Get reference to rc-point-wrapper node
+               anchor-node     (-> pop-border-node .-parentNode .-parentNode .-parentNode)] ;; Get reference to rc-point-wrapper node
            (when (and clipped? (not @found-optimal))
              (reset! position (calculate-optimal-position (calc-element-midpoint anchor-node)))
              (reset! found-optimal true))
-           (calc-metrics @position)))
+           (calc-metrics @position)
+           (reset! ready-to-show? true)))

        :reagent-render
        (fn
@@ -284,6 +288,7 @@
              :style (merge (if @rendered-once
                              (when pop-id (calc-popover-pos orientation @p-width @p-height @pop-offset arrow-length arrow-gap))
                              {:top "-10000px" :left "-10000px"})
+
                            (if width  {:width  width})
                            (if height {:height height})
                            (if popover-color {:background-color popover-color})
@@ -293,7 +298,7 @@
                               :border        "none"})

                            ;; The popover point is zero width, therefore its absolute children will consider this width when deciding their
-                           ;; natural size and in particular, how they natually wrap text. The right hand size of the popover is used as a
+                           ;; natural size and in particular, how they natually wrap text. The right hand side of the popover is used as a
                            ;; text wrapping point so it will wrap, depending on where the child is positioned. The margin is also taken into
                            ;; consideration for this point so below, we set the margins to negative a lot to prevent
                            ;; this annoying wrapping phenomenon.
@@ -306,6 +311,7 @@

                            ;; make it visible and turn off Bootstrap max-width and remove Bootstrap padding which adds an internal white border
                            {:display   "block"
+                            :opacity   (if @ready-to-show? "1" "0")
                             :max-width "none"
                             :padding   "0px"})}
             [popover-arrow orientation @pop-offset arrow-length arrow-width grey-arrow? tooltip-style? popover-color]


Update log message to new name `re-frame-10x`

--- src/re_frame/trace.cljc
+++ src/re_frame/trace.cljc
@@ -36,7 +36,7 @@
   [key f]
   (if trace-enabled?
     (swap! trace-cbs assoc key f)
-    (console :warn "Tracing is not enabled. Please set {\"re_frame.trace.trace_enabled_QMARK_\" true} in :closure-defines. See: https://github.com/Day8/re-frame-trace#installation.")))
+    (console :warn "Tracing is not enabled. Please set {\"re_frame.trace.trace_enabled_QMARK_\" true} in :closure-defines. See: https://github.com/Day8/re-frame-10x#installation.")))

 (defn remove-trace-cb [key]
   (swap! trace-cbs dissoc key)


Exit explicitly even if an exception is thrown

--- src/robip_tool/core.clj
+++ src/robip_tool/core.clj
@@ -36,9 +36,17 @@
       (exit 1 (usage summary))

       errors (exit 1 (error-msg errors)))
-    (let [esp (esprom/esprom (:port options))]
-      (Thread/sleep 0.2)
-      (esprom/connect esp)
-      (esprom/write-flash esp
-                          (map (fn [[addr filename]]
-                                 [(Integer. addr) filename]) (partition 2 arguments))))))
+
+    (try
+      (let [esp (esprom/esprom (:port options))]
+        (Thread/sleep 0.2)
+        (esprom/connect esp)
+        (esprom/write-flash esp
+                            (map (fn [[addr filename]]
+                                   [(Integer. addr) filename]) (partition 2 arguments)))
+        (System/exit 0))
+      (catch Exception e
+        (binding [*out* *err*]
+          (println (.getMessage e))
+          (.printStackTrace e))
+        (System/exit 1)))))


Removed duplicate test for UP01.

Removed duplicate test for UP01.

--- src/alfresco_technical_validation/binary_validation.clj
+++ src/alfresco_technical_validation/binary_validation.clj
@@ -316,19 +316,6 @@
                        ")]
     (standard-validation "STB12" res true "The technology does not use improper logging techniques.")))

-(defn- up01-explorer-ui
-  []
-  (let [res (cy/tquery "
-                         START n=NODE(*)
-                         MATCH (n)-->(m)
-                         WHERE HAS(n.name)
-                           AND HAS(m.package)
-                           AND m.package =~ 'org.alfresco.web..*'
-                        RETURN n.name AS ClassName, COLLECT(DISTINCT m.name) AS APIs
-                         ORDER BY n.name
-                       ")]
-    (standard-validation "UP01" res true "The technology does not extend the Explorer UI.")))
-
 (defn validate
   "Runs all binary-based validations."
   [neo4j-url binaries]
@@ -347,5 +334,4 @@
     (stb06-stb18-manual-transactions)
     (stb10-threading)
     (stb12-logging)
-    (up01-explorer-ui)
   ))


Permit load as a task parameter

Permit load as a task parameter

--- src/cider_ci/builder/task.clj
+++ src/cider_ci/builder/task.clj
@@ -94,7 +94,7 @@
         task-spec (normalize-task-spec raw-task-spec)
         db-task-spec (spec/get-or-create-task-spec task-spec)
         errors (validated-task-spec task-spec)
-        task-row (conj (select-keys task-spec [:name :state :error :priority
+        task-row (conj (select-keys task-spec [:name :state :error :priority :load
                                                :dispatch_storm_delay_seconds])
                        {:job_id job-id
                         :traits (spec-map-to-array (or (:traits task-spec) {}))


Moar starting brew notification messages

--- src/clj/mokkameister/brew.clj
+++ src/clj/mokkameister/brew.clj
@@ -6,7 +6,8 @@
              [pusher :as pusher]
              [slack :as slack]
              [system :refer [system]]
-             [train :refer [rand-train]]]
+             [train :refer [rand-train]]
+             [random :refer [rand-nth-weighted]]]
             [mokkameister.db.persistence :refer [brew-stats persist-brew! find-last-regular-coffee]]))

 (def ^:private channel "#penthouse")
@@ -22,9 +23,21 @@
 (def ^:private mokkameister-link
   "<https://revolverhuset.no/kaffi/|revolverhuset.no/kaffi>")

-(defn- coffee-message-starting [{:keys [slack-user brew-time]} today-count]
-  (format "God nyhendnad folket! %s%s starta nett traktaren, kaffi om %d minuttar!"
-          (msg-coffee-count today-count "") slack-user brew-time))
+(def ^:private brewing-equipment
+  [["traktaren" 60]
+   ["kjelo" 10]
+   ["mokkameister" 20]
+   ["nespressomaskina" 5]
+   ["grutkokaren" 5]
+   ["grutpresså" 5]
+   ["kaffikokaren" 30]])
+
+(defn- coffee-message-starting [{:keys [slack-user brew-time]} today-count]
+  (format "God nyhendnad folket! %s%s starta nett %s, kaffi om %d minuttar!"
+          (msg-coffee-count today-count "")
+          slack-user
+          (rand-nth-weighted brewing-equipment)
+          brew-time))

 (defn- coffee-message-finished []
   (rand-train))


Make UI call API when click on a task

Make UI call API when click on a task

--- src/cljs/bartleby/events.cljs
+++ src/cljs/bartleby/events.cljs
@@ -24,7 +24,7 @@

 (re-frame/reg-event-fx
  :complete-task
- (fn [_ id]
+ (fn [_ [_ id]]
    {:http-xhrio {:method :patch
                  :uri (str "/tasks/" id)
                  :params {:done true}


Group conditions on master field

Group conditions on master field

--- src/cljs/iframe_app/core.cljs
+++ src/cljs/iframe_app/core.cljs
@@ -82,7 +82,34 @@
 (defcomponent condition-detail [condition owner]
   (render-state [_ state]
     (let [{:keys [master-field field-value slave-fields]} condition]
-      (html [:li.rule {:data-id (:id master-field)}
+      (html (let [{:keys [name value]} field-value]
+              [:li.value.selectedRule.hardSelect
+               [:a.ruleItem
+                {:value value
+                 :on-click (fn [_]
+                             (let [{:keys [selector-channel]} (om/get-shared owner)]
+                               (put! selector-channel
+                                     {:selection-to-update :master-field
+                                      :new-value           master-field})
+                               (put! selector-channel
+                                     {:selection-to-update :field-value
+                                      :new-value           field-value})))}
+                [:i.icon-arrow-right] name]
+               [:div.pull-right
+                [:a.deleteRule {:value value} "×"]]
+               [:p
+                [:i.icon-arrow-right]
+                " "
+                (let [slave-field-names (->> slave-fields
+                                             (map :name)
+                                             (clojure.string/join ", "))]
+                  [:em slave-field-names])]])))))
+
+
+;; Conditions grouped by a common master field
+(defcomponent condition-group [{:keys [master-field conditions]} owner]
+  (render-state [_ state]
+    (html [:li.rule {:data-id (:id master-field)}
              [:div.ruleTitle
               [:i.icon-arrow-right]
               [:a.field
@@ -93,29 +120,7 @@
                                      :new-value           master-field})))}
                (:name master-field)]]
              [:ul.unstyled
-              (let [{:keys [name value]} field-value]
-
-                [:li.value.selectedRule.hardSelect
-                 [:a.ruleItem
-                  {:value value
-                   :on-click (fn [_]
-                               (let [{:keys [selector-channel]} (om/get-shared owner)]
-                                 (put! selector-channel
-                                       {:selection-to-update :master-field
-                                        :new-value           master-field})
-                                 (put! selector-channel
-                                       {:selection-to-update :field-value
-                                        :new-value           field-value})))}
-                  [:i.icon-arrow-right] name]
-                 [:div.pull-right
-                  [:a.deleteRule {:value value} "×"]]
-                 [:p
-                  [:i.icon-arrow-right]
-                  " "
-                  (let [slave-field-names (->> slave-fields
-                                               (map :name)
-                                               (clojure.string/join ", "))]
-                    [:em slave-field-names])]])]]))))
+              (om/build-all condition-detail conditions)]])))

@@ -126,7 +131,10 @@
        [:h4.rules_summary_title
         (str "Conditions in this form (" (count conditions) ")")]
        [:ul.unstyled.global
-        (om/build-all condition-detail conditions)]])))
+        (let [grouped-conditions (group-by :master-field conditions)]
+          (for [[master-field conditions] grouped-conditions]
+            (om/build condition-group {:master-field master-field
+                                       :conditions conditions})))]])))

 (defn remove-condition


Show balance, expenses and income values next to each other in events page

--- src/cljs/my_money/events.cljs
+++ src/cljs/my_money/events.cljs
@@ -26,10 +26,10 @@

 (defn balance-info [events]
   (when events
-    [:div
-     [:h1 (str "Balance " (balance events) "€")]
-     [:h1 (str "Expenses " (expenses events) "€")]
-     [:h1 (str "Income " (income events) "€")]]))
+    [:div.container
+     [:h1.col-md-4 (str "Balance " (balance events) "€")]
+     [:h1.col-md-4 (str "Expenses " (expenses events) "€")]
+     [:h1.col-md-4 (str "Income " (income events) "€")]]))

 (defn bank-event-table [events]
   [:div.table-responsive