WIP: remove with-conn, make conn explicity arg

Non-functional at this point, just the first-pass mechanical
transformation

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -8,10 +8,6 @@
             [crypto.password.scrypt :as password]
             [chat.server.schema :refer [schema]]))

-(def ^:dynamic *uri*
-  "URI for the datomic database"
-  (get env :db-url "datomic:free://localhost:4334/braid"))
-
 (defn connect [{:keys [db-url] :as config
                 :or {db-url "datomic:free://localhost:4334/braid"}}]
   (d/connect db-url))
@@ -23,16 +19,15 @@

 (defn init!
   "set up schema"
-  []
-  (d/create-database *uri*)
-  @(d/transact (d/connect *uri*)
+  [{:keys [db-url] :or {db-url "datomic:free://localhost:4334/braid"} :as config}]
+  (d/create-database db-url)
+  @(d/transact (d/connect db-url)
      (concat
        [; partition for our data
         {:db/ident :entities
          :db/id #db/id [:db.part/db]
          :db.install/_partition :db.part/db}]
        schema)))
-

 (defn uuid
   []
@@ -151,14 +146,14 @@
   "create entity with attrs, return entity"
   [attrs]
   (let [new-id (d/tempid :entities)
-        {:keys [db-after tempids]} @(d/transact *conn*
+        {:keys [db-after tempids]} @(d/transact conn
                                                 [(assoc attrs :db/id new-id)])]
     (->> (d/resolve-tempid db-after tempids new-id)
          (d/entity db-after))))

 (defn user-get-preferences
-  [user-id]
-  (->> (d/pull (d/db *conn*)
+  [conn user-id]
+  (->> (d/pull (d/db conn)
                [{:user/preferences [:user.preference/key :user.preference/value]}]
                [:user/id user-id])
        :user/preferences
@@ -167,7 +162,7 @@
                    (map (fn [[k v]] [k (edn/read-string v)]))))))

 (defn user-get-preference
-  [user-id pref]
+  [conn user-id pref]
   (some-> (d/q '[:find ?val .
                  :in $ ?user-id ?key
                  :where
@@ -175,35 +170,35 @@
                  [?u :user/preferences ?p]
                  [?p :user.preference/key ?key]
                  [?p :user.preference/value ?val]]
-               (d/db *conn*) user-id pref)
+               (d/db conn) user-id pref)
           edn/read-string))

 (defn user-preference-is-set?
   "If the preference with the given key has been set for the user, return the
   entity id, else nil"
-  [user-id pref]
+  [conn user-id pref]
   (d/q '[:find ?p .
          :in $ ?user-id ?key
          :where
          [?u :user/id ?user-id]
          [?u :user/preferences ?p]
          [?p :user.preference/key ?key]]
-       (d/db *conn*) user-id pref))
+       (d/db conn) user-id pref))

 (defn user-set-preference!
   "Set a key to a value for the user's preferences.  This will throw if
   permissions are changed in between reading & setting"
-  [user-id k v]
+  [conn user-id k v]
   (if-let [e (user-preference-is-set? user-id k)]
-    @(d/transact *conn* [[:db/add e :user.preference/value (pr-str v)]])
-    @(d/transact *conn* [{:user.preference/key k
+    @(d/transact conn [[:db/add e :user.preference/value (pr-str v)]])
+    @(d/transact conn [{:user.preference/key k
                          :user.preference/value (pr-str v)
                          :user/_preferences [:user/id user-id]
                          :db/id #db/id [:entities]}])))

 (defn user-search-preferences
   "Find the ids of users that have the a given value for a given key set in their preferences"
-  [k v]
+  [conn k v]
   (d/q '[:find [?user-id ...]
          :in $ ?k ?v
          :where
@@ -211,38 +206,38 @@
          [?u :user/preferences ?pref]
          [?pref :user.preference/key ?k]
          [?pref :user.preference/value ?v]]
-       (d/db *conn*)
+       (d/db conn)
        k (pr-str v)))

 (defn get-users-subscribed-to-thread
-  [thread-id]
+  [conn thread-id]
   (d/q '[:find [?user-id ...]
          :in $ ?thread-id
          :where
          [?user :user/id ?user-id]
          [?user :user/subscribed-thread ?thread]
          [?thread :thread/id ?thread-id]]
-       (d/db *conn*)
+       (d/db conn)
        thread-id))

 (defn- get-users-subscribed-to-tag
-  [tag-id]
+  [conn tag-id]
   (d/q '[:find [?user-id ...]
          :in $ ?tag-id
          :where
          [?tag :tag/id ?tag-id]
          [?user :user/subscribed-tag ?tag]
          [?user :user/id ?user-id]]
-       (d/db *conn*)
+       (d/db conn)
        tag-id))

 (defn create-message!
-  [{:keys [thread-id group-id id content user-id created-at
+  [conn {:keys [thread-id group-id id content user-id created-at
            mentioned-user-ids mentioned-tag-ids]}]

   ; upsert-thread
-  (when-not (d/entity (d/db *conn*) [:thread/id thread-id])
-    (d/transact *conn* (concat [{:db/id (d/tempid :entities)
+  (when-not (d/entity (d/db conn) [:thread/id thread-id])
+    (d/transact conn (concat [{:db/id (d/tempid :entities)
                                  :thread/id thread-id
                                  :thread/group [:group/id group-id]}])))

@@ -285,7 +280,7 @@
         ; user who created message: show thread, subscribe to thread
         subscribe-data [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]
                         [:db/add [:user/id user-id] :user/subscribed-thread [:thread/id thread-id]]]
-        {:keys [db-after tempids]} @(d/transact *conn* (concat [msg-data]
+        {:keys [db-after tempids]} @(d/transact conn (concat [msg-data]
                                                                subscribe-data
                                                                txs-for-tag-subscribers
                                                                txs-for-tag-mentions
@@ -299,8 +294,8 @@
          db->message)))

 (defn group-exists?
-  [group-name]
-  (some? (d/pull (d/db *conn*) '[:group/id] [:group/name group-name])))
+  [conn group-name]
+  (some? (d/pull (d/db conn) '[:group/id] [:group/name group-name])))

 (defn create-group!
   [{:keys [name id]}]
@@ -310,8 +305,8 @@
       db->group))

 (defn email-taken?
-  [email]
-  (some? (d/entity (d/db *conn*) [:user/email email])))
+  [conn email]
+  (some? (d/entity (d/db conn) [:user/email email])))

 (defn create-user!
   "creates a user, returns id"
@@ -325,21 +320,21 @@
       db->user))

 (defn nickname-taken?
-  [nickname]
-  (some? (d/entity (d/db *conn*) [:user/nickname nickname])))
+  [conn nickname]
+  (some? (d/entity (d/db conn) [:user/nickname nickname])))

 (defn set-nickname!
   "Set the user's nickname"
-  [user-id nickname]
-  (d/transact *conn* [[:db/add [:user/id user-id] :user/nickname nickname]]))
+  [conn user-id nickname]
+  (d/transact conn [[:db/add [:user/id user-id] :user/nickname nickname]]))

 (defn get-nickname
-  [user-id]
-  (:user/nickname (d/pull (d/db *conn*) '[:user/nickname] [:user/id user-id])))
+  [conn user-id]
+  (:user/nickname (d/pull (d/db conn) '[:user/nickname] [:user/id user-id])))

 (defn authenticate-user
   "returns user-id if email and password are correct"
-  [email password]
+  [conn email password]
   (->> (let [[user-id password-token]
              (d/q '[:find [?id ?password-token]
                     :in $ ?email
@@ -348,34 +343,34 @@
                     [?e :user/email ?stored-email]
                     [(.toLowerCase ^String ?stored-email) ?email]
                     [?e :user/password-token ?password-token]]
-                  (d/db *conn*)
+                  (d/db conn)
                   (.toLowerCase email))]
          (when (and user-id (password/check password password-token))
            user-id))))

 (defn set-user-password!
-  [user-id password]
-  @(d/transact *conn* [[:db/add [:user/id user-id]
+  [conn user-id password]
+  @(d/transact conn [[:db/add [:user/id user-id]
                         :user/password-token (password/encrypt password)]]))

 (defn user-by-id
-  [id]
-  (some-> (d/pull (d/db *conn*) user-pull-pattern [:user/id id])
+  [conn id]
+  (some-> (d/pull (d/db conn) user-pull-pattern [:user/id id])
           db->user))

 (defn user-id-exists?
-  [id]
-  (some? (d/entity (d/db *conn*) [:user/id id])))
+  [conn id]
+  (some? (d/entity (d/db conn) [:user/id id])))

 (defn user-with-email
   "get the user with the given email address or nil if no such user registered"
-  [email]
-  (some-> (d/pull (d/db *conn*) user-pull-pattern [:user/email email])
+  [conn email]
+  (some-> (d/pull (d/db conn) user-pull-pattern [:user/email email])
           db->user))

 (defn user-email
-  [user-id]
-  (:user/email (d/pull (d/db *conn*) [:user/email] [:user/id user-id])))
+  [conn user-id]
+  (:user/email (d/pull (d/db conn) [:user/email] [:user/id user-id])))

 (defn create-invitation!
   [{:keys [id inviter-id invitee-email group-id]}]
@@ -388,8 +383,8 @@
       db->invitation))

 (defn get-invite
-  [invite-id]
-  (some-> (d/pull (d/db *conn*)
+  [conn invite-id]
+  (some-> (d/pull (d/db conn)
               [:invite/id
                {:invite/from [:user/id :user/email :user/nickname]}
                :invite/to
@@ -398,19 +393,19 @@
       db->invitation))

 (defn retract-invitation!
-  [invite-id]
-  (d/transact *conn* [[:db.fn/retractEntity [:invite/id invite-id]]]))
+  [conn invite-id]
+  (d/transact conn [[:db.fn/retractEntity [:invite/id invite-id]]]))

 (defn fetch-users-for-user
   "Get all users visible to given user"
-  [user-id]
+  [conn user-id]
   (->> (d/q '[:find (pull ?e pull-pattern)
               :in $ ?user-id pull-pattern
               :where
               [?u :user/id ?user-id]
               [?g :group/user ?u]
               [?g :group/user ?e]]
-            (d/db *conn*)
+            (d/db conn)
             user-id
             user-pull-pattern)
        (map (comp db->user first))
@@ -418,7 +413,7 @@

 (defn user-visible-to-user?
   "Are the two user ids users that can see each other? i.e. do they have at least one group in common"
-  [user1-id user2-id]
+  [conn user1-id user2-id]
   (-> (d/q '[:find ?g
              :in $ ?u1-id ?u2-id
              :where
@@ -426,11 +421,11 @@
              [?u2 :user/id ?u2-id]
              [?g :group/user ?u1]
              [?g :group/user ?u2]]
-           (d/db *conn*) user1-id user2-id)
+           (d/db conn) user1-id user2-id)
       seq boolean))

 (defn fetch-invitations-for-user
-  [user-id]
+  [conn user-id]
   (->> (d/q '[:find (pull ?i [{:invite/group [:group/id :group/name]}
                               {:invite/from [:user/id :user/email :user/nickname]}
                               :invite/id])
@@ -439,51 +434,51 @@
               [?u :user/id ?user-id]
               [?u :user/email ?email]
               [?i :invite/to ?email]]
-            (d/db *conn*) user-id)
+            (d/db conn) user-id)
        (map (comp db->invitation first))))

 (defn get-open-thread-ids-for-user
-  [user-id]
+  [conn user-id]
   (d/q '[:find [?thread-id ...]
                 :in $ ?user-id
                 :where
                 [?e :user/id ?user-id]
                 [?e :user/open-thread ?thread]
                 [?thread :thread/id ?thread-id]]
-       (d/db *conn*)
+       (d/db conn)
        user-id))

 (defn get-group
-  [group-id]
-  (-> (d/pull (d/db *conn*) group-pull-pattern [:group/id group-id])
+  [conn group-id]
+  (-> (d/pull (d/db conn) group-pull-pattern [:group/id group-id])
       db->group))

-(defn get-groups-for-user [user-id]
+(defn get-groups-for-user [conn user-id]
   (->> (d/q '[:find [?g ...]
               :in $ ?user-id
               :where
               [?u :user/id ?user-id]
               [?g :group/user ?u]]
-            (d/db *conn*)
+            (d/db conn)
             user-id)
-       (d/pull-many (d/db *conn*) group-pull-pattern)
+       (d/pull-many (d/db conn) group-pull-pattern)
        (map (comp #(dissoc % :users) db->group))
        set))

-(defn get-users-in-group [group-id]
+(defn get-users-in-group [conn group-id]
   (->> (d/q '[:find (pull ?u pull-pattern)
               :in $ ?group-id pull-pattern
               :where
               [?g :group/id ?group-id]
               [?g :group/user ?u]]
-            (d/db *conn*)
+            (d/db conn)
             group-id
             user-pull-pattern)
        (map (comp db->user first))
        set))

 (defn get-user-visible-tag-ids
-  [user-id]
+  [conn user-id]
   (->> (d/q '[:find ?tag-id
               :in $ ?user-id
               :where
@@ -491,11 +486,11 @@
               [?g :group/user ?u]
               [?t :tag/group ?g]
               [?t :tag/id ?tag-id]]
-            (d/db *conn*) user-id)
+            (d/db conn) user-id)
        (map first)
        set))

-(defn thread-last-open-at [thread user-id]
+(defn thread-last-open-at [conn thread user-id]
   (let [user-hides-at (->> (d/q
                              '[:find [?inst ...]
                                :in $ ?thread-id ?user-id
@@ -504,7 +499,7 @@
                                [?t :thread/id ?thread-id]
                                [?u :user/open-thread ?t ?tx false]
                                [?tx :db/txInstant ?inst]]
-                             (d/history (d/db *conn*))
+                             (d/history (d/db conn))
                              (thread :id)
                              user-id)
                            (map (fn [t] (.getTime t))))
@@ -515,36 +510,37 @@
     (apply max (concat [0] user-hides-at user-messages-at))))

 (defn thread-group-id
-  [thread-id]
-  (some-> (d/pull (d/db *conn*) [{:thread/group [:group/id]}] [:thread/id thread-id])
+  [conn thread-id]
+  (some-> (d/pull (d/db conn) [{:thread/group [:group/id]}]
+                  [:thread/id thread-id])
           :thread/group :group/id))

 (defn thread-add-last-open-at [thread user-id]
   (assoc thread :last-open-at (thread-last-open-at thread user-id)))

-(defn update-thread-last-open [thread-id user-id]
+(defn update-thread-last-open [conn thread-id user-id]
   (when (seq (d/q '[:find ?t
                     :in $ ?user-id ?thread-id
                     :where
                     [?u :user/id ?user-id]
                     [?t :thread/id ?thread-id]
                     [?u :user/open-thread ?t]]
-                  (d/db *conn*) user-id thread-id))
+                  (d/db conn) user-id thread-id))
     ; TODO: should find a better way of handling this...
-    (d/transact *conn*
+    (d/transact conn
       [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
-    (d/transact *conn*
+    (d/transact conn
       [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]])))

 (defn get-open-threads-for-user
-  [user-id]
+  [conn user-id]
   (let [visible-tags (get-user-visible-tag-ids user-id)]
     (->> (d/q '[:find (pull ?thread pull-pattern)
                 :in $ ?user-id pull-pattern
                 :where
                 [?e :user/id ?user-id]
                 [?e :user/open-thread ?thread]]
-              (d/db *conn*)
+              (d/db conn)
               user-id
               thread-pull-pattern)
          (into ()
@@ -555,32 +551,32 @@
                           first))))))

 (defn get-thread
-  [thread-id]
-  (some-> (d/pull (d/db *conn*) thread-pull-pattern [:thread/id thread-id])
+  [conn thread-id]
+  (some-> (d/pull (d/db conn) thread-pull-pattern [:thread/id thread-id])
           db->thread))

 (defn get-threads
-  [thread-ids]
+  [conn thread-ids]
   (->> thread-ids
        (map (fn [id] [:thread/id id]))
-       (d/pull-many (d/db *conn*) thread-pull-pattern)
+       (d/pull-many (d/db conn) thread-pull-pattern)
        (map db->thread)))

 (defn get-subscribed-thread-ids-for-user
-  [user-id]
+  [conn user-id]
   (d/q '[:find [?thread-id ...]
          :in $ ?user-id
          :where
          [?user :user/id ?user-id]
          [?user :user/subscribed-thread ?thread]
          [?thread :thread/id ?thread-id]]
-       (d/db *conn*)
+       (d/db conn)
        user-id))

 (defn user-hide-thread!
-  [user-id thread-id]
+  [conn user-id thread-id]
   (d/transact
-    *conn*
+    conn
     [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]]))

 (defn create-tag! [attrs]
@@ -590,22 +586,22 @@
       create-entity!
       db->tag))

-(defn tag-group-id [tag-id]
-  (-> (d/pull (d/db *conn*) [{:tag/group [:group/id]}] [:tag/id tag-id])
+(defn tag-group-id [conn tag-id]
+  (-> (d/pull (d/db conn) [{:tag/group [:group/id]}] [:tag/id tag-id])
       (get-in [:tag/group :group/id])))

 (defn user-in-group?
-  [user-id group-id]
+  [conn user-id group-id]
   (seq (d/q '[:find ?g
               :in $ ?user-id ?group-id
               :where
               [?u :user/id ?user-id]
               [?g :group/id ?group-id]
               [?g :group/user ?u]]
-            (d/db *conn*)
+            (d/db conn)
             user-id group-id)))

-(defn user-in-tag-group? [user-id tag-id]
+(defn user-in-tag-group? [conn user-id tag-id]
   (seq (d/q '[:find ?g
               :in $ ?user-id ?tag-id
               :where
@@ -613,19 +609,19 @@
               [?t :tag/id ?tag-id]
               [?t :tag/group ?g]
               [?g :group/user ?u]]
-            (d/db *conn*)
+            (d/db conn)
             user-id tag-id)))

 (defn user-can-see-thread?
-  [user-id thread-id]
+  [conn user-id thread-id]
   (or
     ;user can see the thread if it's a new (i.e. not yet in the database) thread...
-    (nil? (d/entity (d/db *conn*) [:thread/id thread-id]))
+    (nil? (d/entity (d/db conn) [:thread/id thread-id]))
     ; ...or they're already subscribed to the thread...
     (contains? (set (get-users-subscribed-to-thread thread-id)) user-id)
     ; ...or they're mentioned in the thread
     ; TODO: is it possible for them to be mentioned but not subscribed?
-    (contains? (-> (d/pull (d/db *conn*) [:thread/mentioned] [:thread/id thread-id])
+    (contains? (-> (d/pull (d/db conn) [:thread/mentioned] [:thread/id thread-id])
                    :thread/mentioned set)
                user-id)
     ; ...or they are in the group of any tags on the thread
@@ -637,32 +633,32 @@
                 [?tag :tag/group ?group]
                 [?group :group/user ?user]
                 [?user :user/id ?user-id]]
-              (d/db *conn*) thread-id user-id))))
-
-(defn user-subscribe-to-tag! [user-id tag-id]
+              (d/db conn) thread-id user-id))))
+
+(defn user-subscribe-to-tag! [conn user-id tag-id]
   ; TODO: throw an exception/some sort of error condition if user tried to
   ; subscribe to a tag they can't?
   (when (user-in-tag-group? user-id tag-id)
-    (d/transact *conn* [[:db/add [:user/id user-id]
+    (d/transact conn [[:db/add [:user/id user-id]
                          :user/subscribed-tag [:tag/id tag-id]]])))

 (defn user-unsubscribe-from-tag!
-  [user-id tag-id]
-  (d/transact *conn* [[:db/retract [:user/id user-id]
+  [conn user-id tag-id]
+  (d/transact conn [[:db/retract [:user/id user-id]
                        :user/subscribed-tag [:tag/id tag-id]]]))

-(defn user-add-to-group! [user-id group-id]
-  (d/transact *conn* [[:db/add [:group/id group-id]
+(defn user-add-to-group! [conn user-id group-id]
+  (d/transact conn [[:db/add [:group/id group-id]
                        :group/user [:user/id user-id]]]))

-(defn user-make-group-admin! [user-id group-id]
-  (d/transact *conn* [[:db/add [:group/id group-id]
+(defn user-make-group-admin! [conn user-id group-id]
+  (d/transact conn [[:db/add [:group/id group-id]
                        :group/user [:user/id user-id]]
                       [:db/add [:group/id group-id]
                        :group/admins [:user/id user-id]]]))

 (defn user-is-group-admin?
-  [user-id group-id]
+  [conn user-id group-id]
   (some?
     (d/q '[:find ?u .
            :in $ ?user-id ?group-id
@@ -670,35 +666,35 @@
            [?g :group/id ?group-id]
            [?u :user/id ?user-id]
            [?g :group/admins ?u]]
-         (d/db *conn*) user-id group-id)))
+         (d/db conn) user-id group-id)))

 (defn user-subscribe-to-group-tags!
   "Subscribe the user to all current tags in the group"
-  [user-id group-id]
+  [conn user-id group-id]
   (->> (d/q '[:find ?tag
               :in $ ?group-id
               :where
               [?tag :tag/group ?g]
               [?g :group/id ?group-id]]
-            (d/db *conn*) group-id)
+            (d/db conn) group-id)
        (map (fn [[tag]]
               [:db/add [:user/id user-id]
                :user/subscribed-tag tag]))
-       (d/transact *conn*)))
+       (d/transact conn)))

 (defn get-user-subscribed-tag-ids
-  [user-id]
+  [conn user-id]
   (d/q '[:find [?tag-id ...]
          :in $ ?user-id
          :where
          [?user :user/id ?user-id]
          [?user :user/subscribed-tag ?tag]
          [?tag :tag/id ?tag-id]]
-       (d/db *conn*)
+       (d/db conn)
        user-id))

 (defn get-group-tags
-  [group-id]
+  [conn group-id]
   (->> (d/q '[:find (pull ?t [:tag/id
                               :tag/name
                               :tag/description
@@ -707,11 +703,11 @@
               :where
               [?g :group/id ?group-id]
               [?t :tag/group ?g]]
-            (d/db *conn*) group-id)
+            (d/db conn) group-id)
        (map (comp db->tag first))))

 (defn fetch-tag-statistics-for-user
-  [user-id]
+  [conn user-id]
   (->> (d/q '[:find
               ?tag-id
               (count-distinct ?th)
@@ -724,7 +720,7 @@
               [?t :tag/id ?tag-id]
               [?sub :user/subscribed-tag ?t]
               [?th :thread/tag ?t]]
-            (d/db *conn*) user-id)
+            (d/db conn) user-id)
        (map (fn [[tag-id threads-count subscribers-count]]
               [tag-id {:tag/threads-count threads-count
                        :tag/subscribers-count subscribers-count}]))
@@ -732,7 +728,7 @@

 (defn fetch-tags-for-user
   "Get all tags visible to the given user"
-  [user-id]
+  [conn user-id]
   (let [tag-stats (fetch-tag-statistics-for-user user-id)]
     (->> (d/q '[:find
                 (pull ?t [:tag/id
@@ -744,7 +740,7 @@
                 [?u :user/id ?user-id]
                 [?g :group/user ?u]
                 [?t :tag/group ?g]]
-              (d/db *conn*) user-id)
+              (d/db conn) user-id)
          (map (fn [[tag]]
                 (db->tag (merge tag (tag-stats (tag :tag/id))))))
          (into #{}))))
@@ -753,7 +749,7 @@
   "Find threads with a given tag that the user is allowed to see, ordered by most recent message.
   Paginates results, dropping `skip` threads and returning `limit`.
   Returns the threads and a count of how many threads remain."
-  [user-id tag-id skip limit]
+  [conn user-id tag-id skip limit]
   (let [all-thread-eids (d/q '[:find ?thread (max ?time)
                                :in $ ?tag-id
                                :where
@@ -761,20 +757,20 @@
                                [?thread :thread/tag ?tag]
                                [?msg :message/thread ?thread]
                                [?msg :message/created-at ?time]]
-                              (d/db *conn*) tag-id)
+                              (d/db conn) tag-id)
         thread-eids (->> all-thread-eids
                          (sort-by second #(compare %2 %1))
                          (map first)
                          (drop skip)
                          (take limit))]
-    {:threads (->> (d/pull-many (d/db *conn*) thread-pull-pattern thread-eids)
+    {:threads (->> (d/pull-many (d/db conn) thread-pull-pattern thread-eids)
                    (map db->thread)
                    (filter (fn [thread] (user-can-see-thread? user-id (thread :id)))))
      :remaining (- (count all-thread-eids) (+ skip (count thread-eids)))}))

 (defn tag-set-description!
-  [tag-id description]
-  (d/transact *conn* [[:db/add [:tag/id tag-id]
+  [conn tag-id description]
+  (d/transact conn [[:db/add [:tag/id tag-id]
                        :tag/description description]]))

 (defn create-extension!
@@ -788,24 +784,24 @@
       db->extension))

 (defn retract-extension!
-  [extension-id]
-  @(d/transact *conn* [[:db.fn/retractEntity [:extension/id extension-id]]]))
+  [conn extension-id]
+  @(d/transact conn [[:db.fn/retractEntity [:extension/id extension-id]]]))

 (defn extension-by-id
-  [extension-id]
-  (-> (d/pull (d/db *conn*) extension-pull-pattern [:extension/id extension-id])
+  [conn extension-id]
+  (-> (d/pull (d/db conn) extension-pull-pattern [:extension/id extension-id])
       db->extension))

 (defn save-extension-token!
-  [extension-id {:keys [access-token refresh-token]}]
-  @(d/transact *conn* [[:db/add [:extension/id extension-id]
+  [conn extension-id {:keys [access-token refresh-token]}]
+  @(d/transact conn [[:db/add [:extension/id extension-id]
                         :extension/token access-token]
                        [:db/add [:extension/id extension-id]
                         :extension/refresh-token refresh-token]]))

 (defn update-extension-config!
-  [extension-id config]
-  @(d/transact *conn* [[:db/add [:extension/id extension-id]
+  [conn extension-id config]
+  @(d/transact conn [[:db/add [:extension/id extension-id]
                        :extension/config (pr-str config)]]))

 (defn set-extension-config!
@@ -814,7 +810,7 @@
     (update-extension-config! extension-id (assoc (:config ext) k v))))

 (defn thread-visible-to-extension?
-  [thread-id ext-id]
+  [conn thread-id ext-id]
   (seq (d/q '[:find ?group
               :in $ ?thread-id ?ext-id
               :where
@@ -823,50 +819,50 @@
               [?thread :thread/tag ?tag]
               [?tag :tag/group ?group]
               [?ext :extension/group ?group]]
-            (d/db *conn*) thread-id ext-id)))
+            (d/db conn) thread-id ext-id)))

 (defn extension-subscribe
-  [extension-id thread-id]
+  [conn extension-id thread-id]
   (assert (thread-visible-to-extension? thread-id extension-id))
-  @(d/transact *conn* [[:db/add [:extension/id extension-id]
+  @(d/transact conn [[:db/add [:extension/id extension-id]
                         :extension/watched-threads [:thread/id thread-id]]]))

 (defn extensions-watching
   "Get the extensions that are watching the given thread"
-  [thread-id]
-  (->> (d/pull (d/db *conn*) [{:extension/_watched-threads extension-pull-pattern}]
+  [conn thread-id]
+  (->> (d/pull (d/db conn) [{:extension/_watched-threads extension-pull-pattern}]
                [:thread/id thread-id])
        :extension/_watched-threads
        (map db->extension)))

 (defn group-extensions
-  [group-id]
-  (->> (d/pull (d/db *conn*) [{:extension/_group extension-pull-pattern}]
+  [conn group-id]
+  (->> (d/pull (d/db conn) [{:extension/_group extension-pull-pattern}]
                [:group/id group-id])
        :extension/_group
        (map db->extension)))

 (defn group-settings
-  [group-id]
-  (->> (d/pull (d/db *conn*) [:group/settings] [:group/id group-id])
+  [conn group-id]
+  (->> (d/pull (d/db conn) [:group/settings] [:group/id group-id])
        :group/settings
        ((fnil edn/read-string "{}"))))

 (defn group-set!
   "Set a key to a value for the group's settings  This will throw if
   settings are changed in between reading & setting"
-  [group-id k v]
-  (let [old-prefs (-> (d/pull (d/db *conn*) [:group/settings] [:group/id group-id])
+  [conn group-id k v]
+  (let [old-prefs (-> (d/pull (d/db conn) [:group/settings] [:group/id group-id])
                       :group/settings)
         new-prefs (-> ((fnil edn/read-string "{}") old-prefs)
                       (assoc k v)
                       pr-str)]
-    (d/transact *conn* [[:db.fn/cas [:group/id group-id]
+    (d/transact conn [[:db.fn/cas [:group/id group-id]
                          :group/settings old-prefs new-prefs]])))

 (defn public-group-with-name
-  [group-name]
-  (when-let [group (-> (d/pull (d/db *conn*) group-pull-pattern
+  [conn group-name]
+  (when-let [group (-> (d/pull (d/db conn) group-pull-pattern
                                [:group/name group-name])
                        db->group)]
     (when (:public? (group-settings (group :id)))


Update cards.clj

Update cards.clj

remove extra colon

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -2161,7 +2161,7 @@
                 {:label "Place 1 advancement token on an ICE that can be advanced on this server"
                  :msg (msg "place 1 advancement token on " (if (:rezzed target) (:title target) "a card"))
                  :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
-                 ::effect (effect (add-prop target :advance-counter 1))}]}
+                 :effect (effect (add-prop target :advance-counter 1))}]}

    "Bullfrog"
    {:abilities [{:msg "start a Psi game"


add some Chrome City cards

add some Chrome City cards

A couple of these probably need some tweaks--in particular, Corporate Town. I threw together a hybrid of Hades Fragment and Character Assassination, but this might be somewhat prone to error--the Runner could in theory have multiple Daily Casts or Liberated Accounts installed with different amounts of remaining credits, so I don't know that the prompt could distinguish between them and you wouldn't know which one you were trashing.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -343,6 +343,17 @@

    "Corporate Shuffle"
    {:effect (effect (shuffle-into-deck :hand) (draw 5))}
+
+   "Corporate Town"
+   {:additional-cost [:forfeit]
+    {:events {:corp-turn-begins
+             {:optional
+              {:prompt "Trash 1 resource?"
+               :effect (effect (resolve-ability
+                                 {:prompt "Choose a resource to trash"
+                                  :choices (req (get-in runner [:rig :resource]))
+                                  :msg (msg "trash " (:title target))
+                                  :effect (effect (trash target))}))}}}}}

    "Corporate Troubleshooter"
    {:abilities [{:label "Add strength to a rezzed ICE protecting this server" :choices :credit
@@ -1785,6 +1796,9 @@
                         :effect (req (doseq [c (get-in (:servers corp) (conj (:server run) :content))]
                                        (trash state side c)))}} card))}

+   "Skulljack"
+   {:effect (effect (damage :brain 1))}
+
    "Snatch and Grab"
    {:trace {:base 3 :choices {:req #(has? % :subtype "Connection")}
             :msg (msg "attempt to trash " (:title target))
@@ -1991,6 +2005,9 @@
    "Titan Transnational: Investing In Your Future"
    {:events {:agenda-scored {:msg (msg "add 1 agenda counter to " (:title target))
                              :effect (effect (add-prop target :counter 1))}}}
+
+   "Titanium Ribs"
+   {:effect (effect (damage :meat 2))}

    "Toshiyuki Sakai"
    {:advanceable :always}
@@ -2036,6 +2053,9 @@
                              tol nil)))}
             card nil)))}

+   "Turntable"
+   {:effect (effect (gain :memory 1)) :leave-play (effect (lose :memory 1))}
+
    "Turtlebacks"
    {:events {:server-created {:msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}

@@ -2210,6 +2230,9 @@
    {:abilities [{:cost [:credit 2] :msg "break 1 sentry subroutine"}
                 {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1))}]}

+   "Crowbar"
+   {:abilities [{:msg "break up to 3 code gate subroutines" :effect (effect (trash card))}]}
+
    "Crypsis"
    {:abilities [{:cost [:credit 1] :msg "break ICE subroutine"}
                 {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1))}
@@ -2441,6 +2464,12 @@
     :msg (msg "change its subtype to " target) :end-turn {:effect (effect (derez card))}
     :abilities [{:msg "end the run" :effect (effect (end-run))}]}

+   "Clairvoyant Monitor"
+   {:abilities [{:msg "start a Psi game"
+                 :psi {:not-equal {:msg (msg "place 1 advancement token on " (if (:rezzed target) (:title target) "a card and end the run"))
+                                   :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
+                                   :effect (effect (add-prop target :advance-counter 1) (end-run))}}}]}
+
    "Chum"
    {:abilities [{:msg "do 3 net damage" :effect (effect (damage :net 3))}]}

@@ -2608,10 +2637,17 @@
    "Komainu"
    {:abilities [{:msg "do 1 net damage" :effect (effect (damage :net 1))}]}

+   "Lab Dog"
+   {:abilities [{:msg "force the Runner trash an installed piece of Hardware" :effect (effect (trash card))}]}
+
    "Lancelot"
    {:abilities [{:prompt "Choose a program to trash" :msg (msg "trash " (:title target))
                  :label "Trash a program" :choices (req (get-in runner [:rig :program]))
                  :effect (effect (trash target))}]}
+
+   "Little Engine"
+   {:abilities [{:msg "end the run" :effect (effect (end-run))}
+                {:msg "make the Runner gain 5 [Credits]" :effect (effect (gain :runner :credit 5))}]}

    "Lotus Field"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}
@@ -2735,6 +2771,10 @@
    "Quandary"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}

+   "Quicksand"
+   {:abilities [{:msg "add 1 power counter" :effect (effect (add-prop card :counter 1))}
+                {:msg "end the run" :effect (effect (end-run))}]}
+
    "Rainbow"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}


Fix typo, retract now fires in insert-unconditional

--- src/clj/libx/util.cljc
+++ src/clj/libx/util.cljc
@@ -216,7 +216,7 @@
     (if (empty? to-retract)
       (cr/insert-all-unconditional! to-insert)
       (do (cr/insert-all-unconditional! to-insert)
-          (doseq [x to-retract] (cr/retract!) x)))))
+          (doseq [x to-retract] (cr/retract! x))))))

 (defn action-insert! [m]
   (insert-unconditional! (gen-Tuples-from-map m)))


check-for-serious-error: stop acquisition engine if a serious error is reported

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8779 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -28,7 +28,7 @@
         [org.micromanager.sequence-generator :only [generate-acq-sequence
                                                     make-property-sequences]])
   (:require [clojure.set])
-  (:import [org.micromanager AcqControlDlg]
+  (:import [org.micromanager AcqControlDlg MMStudioMainFrame]
            [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
            [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcq TaggedImageQueue
                                          ProcessorStack SequenceSettings MMImageCache
@@ -78,6 +78,10 @@
 (def active-slice-sequence (atom nil))

 (def pixel-type-depths {"GRAY8" 1 "GRAY16" 2 "RGB32" 4 "RGB64" 8})
+
+(defn check-for-serious-error []
+  (when (.. MMStudioMainFrame seriousErrorReported_ get)
+    (swap! state :stop true)))

 ;; time

@@ -333,6 +337,7 @@
         bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))]
     (doall
       (loop [burst-seqs bursts-per-camera-channel i 0]
+        (check-for-serious-error)
         (if (and (not (@state :stop))
                  (not (apply = nil burst-seqs))
                  (or (pos? (core getRemainingImageCount))
@@ -565,6 +570,7 @@

 (defn execute [event-fns]
   (doseq [event-fn event-fns :while (not (:stop @state))]
+    (check-for-serious-error)
     (try (event-fn) (catch Throwable e (ReportingUtils/logError e)))
     (await-resume)))


Fix reflection warning

Fix reflection warning

--- systems/ring/src/containium/systems/ring.clj
+++ systems/ring/src/containium/systems/ring.clj
@@ -54,7 +54,7 @@
   "Evaluates to a match form, used by the make-app function."
   [{:keys [host-regex context-path]} uri-sym host-sym]
   (let [host-test `(re-matches ~(if host-regex (re-pattern host-regex)) ~host-sym)
-        context-test `(and (.startsWith ~uri-sym ~context-path)
+        context-test `(and (.startsWith (str ~uri-sym) ~context-path)
                            (= (get ~uri-sym ~(count context-path)) \/))]
     `(and ~@(remove nil? (list (when host-regex host-test)
                                (when context-path context-test))))))


use `seq` instead of `(not (empty? ...))`

--- src-cljs/frontend/models/build.cljs
+++ src-cljs/frontend/models/build.cljs
@@ -166,7 +166,7 @@
        (#{"not_running" "running" "queued" "scheduled"} (:lifecycle build))))

 (defn has-pull-requests? [build]
-  (not (empty? (:pull_request_urls build))))
+  (seq (:pull_request_urls build)))

 (defn can-merge? [build]
   (and (= "success" (:outcome build))


Add ns docstring

Add ns docstring

--- src/cortex/network.clj
+++ src/cortex/network.clj
@@ -1,4 +1,5 @@
 (ns cortex.network
+  "Namespace for constructing and managing neural networks"
   (:require [clojure.core.matrix :as mat]
             [cortex.protocols :as cp]
             [clojure.core.matrix.linear :as linear]


Don't cause REPL seizure calling patch-fixture!

--- src/afterglow/show.clj
+++ src/afterglow/show.clj
@@ -1226,7 +1226,8 @@
                          (transform/transform-fixture-euler fixture x y z x-rotation y-rotation z-rotation))]
     (swap! (:fixtures *show*) #(patch-fixture-internal *show* % (keyword key)
                                                        (chan/patch-fixture positioned universe start-address next-id))))
-  (swap! (:dimensions *show*) (constantly (calculate-dimensions *show*))))
+  (reset! (:dimensions *show*) (calculate-dimensions *show*))
+  key) ; Don't return the dimensions, it is a deep recursive structure which causes print spasms.

 (defn patch-fixture-group!
   "*Deprecated until it supports positioning each fixture.*


adding eip functions

adding eip functions

--- src/aws/networking.clj
+++ src/aws/networking.clj
@@ -61,5 +61,13 @@
       :debian  true ; hothing special todo
       :redhat  (redhat-hostname fqdn remote)
       (throw+ ::no-matching-flavor :msg (<< "no os flavor found for ~{os}")))
-    (with-ctx ec2/create-tags [(instance-desc endpoint instance-id :id)] {:Name hostname})
+    (with-ctx ec2/create-tags
+      {:resources [instance-id] :tags [{:key "Name" :value hostname}]})
     ))
+
+(defn describe-eip [endpoint instance-id]
+  (with-ctx ec2/describe-addresses :filters
+    [{:name "instance-id" :values [instance-id]}]))
+
+(defn assoc-pub-ip [endpoint instance-id ip]
+  (with-ctx ec2/associate-address {:instance-id instance-id :public-ip ip}))


rewrite (defn sentences []) to use 1. shuffled set of all preds for all verbs, 2. require a more complex sentence structure

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -112,21 +112,28 @@
                              (= as-numbered-list "true"))
         count (or (Integer. count) 100)
         model (or model (medium))
-        spec (or (and spec
-                      (unifyc spec {:modified false}))
-                 {:modified false
-                  :synsem {:subcat '()
-                           :cat :verb}})]
+        spec-fn (or (and spec (fn [] spec))
+                    (fn []
+                      (let [preds
+                            (vec (set (filter #(not (= :top %))
+                                              (map #(get-in % [:synsem :sem :pred] :top)
+                                                   (filter #(= (get-in % [:synsem :cat]) :verb)
+                                                           (flatten (vals (:lexicon (medium)))))))))]
+                        {:synsem {:sem {:pred (first (take 1 (shuffle preds)))}
+                                  :cat :verb}
+                         :head {:phrasal true
+                                :comp {:phrasal true}}
+                         :comp {:phrasal true}})))]
     (println (str "count: " count))
-    (println (str "spec:" spec))
     (doall (pmap
             (fn [num]
-              (let [expr (generate spec
+              (let [spec (spec-fn)
+                    expr (generate (spec-fn)
                                    :model model)
                     fo (morph expr :show-notes false)]
                 (let [to-print
                       (cond
-                        (empty? fo) (str "(failed)")
+                        (empty? fo) (str "(failed: spec=" spec ")")
                         true
                         (str (string/capitalize (nth fo 0))
                              (string/join "" (rest (vec fo)))


+clojure.repl/doc

+clojure.repl/doc

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -6,6 +6,7 @@
    [babel.english.grammar :refer [medium small-plus-vp-pronoun small-plus-plus-np]]
    [babel.english.morphology :as morph :refer [fo]]
    [babel.parse :as parse]
+   [clojure.repl :refer [doc]]
    [clojure.string :as string]
    [dag_unify.core :refer [fail? get-in strip-refs]]))


Cider-nrepl and lein-ancient version bump

--- dot/lein/profiles.clj
+++ dot/lein/profiles.clj
@@ -1,7 +1,7 @@
 {:user
  {:plugins [[lein-vanity "0.2.0" :exclusions [org.clojure/clojure]]
-            [lein-ancient "0.5.5"]
+            [lein-ancient "0.6.5"]
             [jonase/eastwood "0.2.0"]
-            [cider/cider-nrepl "0.8.2"]]
+            [cider/cider-nrepl "0.9.0-SNAPSHOT"]]
   :dependencies [[slamhound "1.5.5"]]
   :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


Adapt jws implementation to the same behavior as new jwe.

--- src/buddy/sign/jws.clj
+++ src/buddy/sign/jws.clj
@@ -24,10 +24,12 @@
             [buddy.core.sign.rsapss :as rsapss]
             [buddy.core.sign.rsapkcs15 :as rsapkcs]
             [buddy.core.sign.ecdsa :as ecdsa]
-            [buddy.sign.util :refer [to-timestamp timestamp] :as util]
+            [buddy.sign.util :as util]
             [clojure.string :as str]
             [cheshire.core :as json]
-            [cats.monad.either :as either])
+            [cats.monad.exception :as exc]
+            [slingshot.slingshot :refer [throw+]])
+
   (:import clojure.lang.Keyword))

 (def ^{:doc "List of supported signing algorithms"
@@ -58,7 +60,7 @@
   [data]
   (into {} (map (fn [[key val]]
                   (if (satisfies? util/ITimestamp val)
-                    [key (to-timestamp val)]
+                    [key (util/to-timestamp val)]
                     [key val])) data)))

 (defn normalize-nil-claims
@@ -88,11 +90,15 @@

 (defn parse-header
   "Parse jws header."
-  [^String headerdata]
-  (-> headerdata
-      (codecs/safebase64->bytes)
-      (codecs/bytes->str)
-      (json/parse-string true)))
+  [^String header]
+  (let [header (codecs/safebase64->str header)
+        {:keys [alg] :as header} (json/parse-string header true)]
+    (when (nil? alg)
+      (throw+ {:type :validation
+               :cause :header
+               :message "Missing `alg` key in header."}))
+    (merge {:alg (keyword (str/lower-case alg))}
+           (dissoc header :alg))))

 (defn parse-claims
   "Parse jws claims"
@@ -102,40 +108,96 @@
       (codecs/bytes->str)
       (json/parse-string true)))

-(defn parse-algorithm
-  "Parse algorithm name and return a
-  internal keyword representation of it."
-  [header]
-  (let [algname (:alg header)]
-    (keyword (.toLowerCase algname))))
-
-(defn get-verifier-for-algorithm
-  "Get verifier function for algorithm name."
-  [^Keyword alg]
-  (when (contains? *signers-map* alg)
-    (get-in *signers-map* [alg :verifier])))
-
-(defn get-signer-for-algorithm
-  "Get signer function for algorithm name."
-  [^Keyword alg]
-  (when (contains? *signers-map* alg)
-    (get-in *signers-map* [alg :signer])))
-
-(defn safe-encode
-  "Properly encode string into
-  safe url base64 encoding."
-  [^String input]
-  (-> input
-      (codecs/str->bytes)
-      (codecs/bytes->safebase64)))
-
-(defn calculate-signature
-  "Make a jws signature."
-  [pkey alg header claims]
-  (let [candidate (str/join "." [header claims])
-        signer    (get-signer-for-algorithm alg)]
-    (-> (signer candidate pkey)
-        (codecs/bytes->safebase64))))
+(defmulti calculate-signature :alg)
+(defmulti verify-signature :alg)
+
+(defmethod calculate-signature :hs256
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (hmac/hash key :sha256)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :hs512
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (hmac/hash key :sha512)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :rs256
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapkcs/sign key :sha256)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :rs512
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapkcs/sign key :sha512)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :ps256
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapss/sign key :sha256)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :ps512
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapss/sign key :sha512)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :es256
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (ecdsa/sign key :sha256)
+      (codecs/bytes->safebase64)))
+
+(defmethod calculate-signature :es512
+  [{:keys [key alg header claims]}]
+  (-> (str/join "." [header claims])
+      (ecdsa/sign key :sha512)
+      (codecs/bytes->safebase64)))
+
+(defmethod verify-signature :hs256
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (hmac/verify signature key :sha256)))
+
+(defmethod verify-signature :hs512
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (hmac/verify signature key :sha512)))
+
+(defmethod verify-signature :rs256
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapkcs/verify signature key :sha256)))
+
+(defmethod verify-signature :rs512
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapkcs/verify signature key :sha512)))
+
+(defmethod verify-signature :ps256
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapss/verify signature key :sha256)))
+
+(defmethod verify-signature :ps512
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (rsapss/verify signature key :sha512)))
+
+(defmethod verify-signature :es256
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (ecdsa/verify signature key :sha256)))
+
+(defmethod verify-signature :es512
+  [{:keys [alg signature key header claims]}]
+  (-> (str/join "." [header claims])
+      (ecdsa/verify signature key :sha512)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Public Api
@@ -146,10 +208,14 @@
   json web token/signature."
   [claims pkey & [{:keys [alg exp nbf iat headers] :or {alg :hs256 headers {}}}]]
   {:pre [(map? claims)]}
-  (let [header (encode-header alg headers)
-        claims (encode-claims claims exp nbf iat)
-        signature (calculate-signature pkey alg header claims)]
-    (either/right (str/join "." [header claims signature]))))
+  (exc/try-on
+   (let [header (encode-header alg headers)
+         claims (encode-claims claims exp nbf iat)
+         signature (calculate-signature {:key pkey
+                                         :alg alg
+                                         :header header
+                                         :claims claims})]
+     (str/join "." [header claims signature]))))

 (defn decode
   "Given a signed message, verify it and return
@@ -160,39 +226,39 @@
   and verification, it will be reported in an
   either/left instance."
   [input pkey & [{:keys [max-age] :as opts}]]
-  {:pre [(string? input)]}
-  (let [[header claims signature] (str/split input #"\." 3)
-        candidate (str/join "." [header claims])
-        header (parse-header header)
-        claims (parse-claims claims)
-        algorithm (parse-algorithm header)
-        signature (codecs/safebase64->bytes signature)
-        verifier (get-verifier-for-algorithm algorithm)
-        result (verifier candidate signature pkey)]
-    (if (false? result)
-      (either/left "Invalid token.")
-      (let [now (timestamp)]
-        (cond
-          (and (:exp claims) (> now (:exp claims)))
-          (either/left (format "Token is older than :exp (%s)" (:exp claims)))
-
-          (and (:nbf claims) (> now (:nbf claims)))
-          (either/left (format "Token is older than :nbf (%s)" (:nbf claims)))
-
-          (and (:iat claims) (number? max-age) (> (- now (:iat claims)) max-age))
-          (either/left (format "Token is older than max-age (%s)" max-age))
-
-          :else
-          (either/right claims))))))
+  (exc/try-on
+   (let [[header claims signature] (str/split input #"\." 3)
+         {:keys [alg]} (parse-header header)
+         signature (codecs/safebase64->bytes signature)]
+     (when-not (verify-signature {:key pkey :signature signature
+                                  :alg alg :header header :claims claims})
+       (throw+ {:type :validation :cause :auth :message "Message seems corrupt or manipulated."}))
+     (let [claims (parse-claims claims)
+           now (util/timestamp)]
+       (cond
+         (and (:exp claims) (> now (:exp claims)))
+         (throw+ {:type :validation
+                  :cause :exp
+                  :message (format "Token is older than :exp (%s)" (:exp claims))})
+
+         (and (:nbf claims) (> now (:nbf claims)))
+         (throw+ {:type :validation
+                  :cause :nbf
+                  :message (format "Token is older than :nbf (%s)" (:nbf claims))})
+
+         (and (:iat claims) (number? max-age) (> (- now (:iat claims)) max-age))
+         (throw+ {:type :validation
+                  :cause :nbf
+                  :message (format "Token is older than max-age (%s)" max-age)})
+
+         :else claims)))))

 (defn sign
   "Not monadic version of encode."
   [& args]
-  (either/from-either (apply encode args)))
+  (deref (apply encode args)))

 (defn unsign
   "Not monadic version of decode."
   [& args]
-  (let [result (apply decode args)]
-    (when (either/right? result)
-      (either/from-either result))))
+  (deref (apply decode args)))


fix wrong indexing on branches

fix wrong indexing on branches

--- src-cljs/cljs_workspace/om_history.cljs
+++ src-cljs/cljs_workspace/om_history.cljs
@@ -34,10 +34,14 @@
 (def current-branch (atom {:id (generate-uuid) :data (atom [])}))

 ;; global atom referencing the total history graph
-(def app-history (atom {:root @current-branch :data (@current-branch :data)}))
+(def app-history (atom {:id 1 :root @current-branch :data (@current-branch :data)}))

 ;; ffd
 (def history-view)
+
+;; this variable indicates that we are currently reverted to an earlier
+;; state of the branch and also which one we have reverted to
+(def reverted-to (atom -1))

 (defn most-recent-state []
   (let [l (len @(@current-branch :data))]
@@ -53,7 +57,7 @@
   (reset! current-branch branch)
   (when-let [s (most-recent-state)]
     (reset! app-state s))
-  (render-tree @app-history @current-branch (fn [branch] (switch-to-branch branch))))
+  (render-tree @app-history @current-branch (fn [branch] (switch-to-branch branch)) (* (len @(branch :data)) (/ index 100))))

 (defn nth-history
   ([i]
@@ -83,7 +87,7 @@
 (defn branch-morph [posX posY width height branch]
          {:id (branch :id)
           :morph {:Position {:x posX :y posY}
-                  :onClick (fn [e] (switch-to-branch branch))}
+                  :onClick (fn [this] (switch-to-branch branch))}
           :shape {:Fill "green"
                   :BorderColor "darkgreen"
                   :Extent {:x width :y height}}
@@ -105,10 +109,6 @@
 (defn move-indicator-to [index]
   (set-position history-view "indexMorph" {:x (* diagram-width (/ index 100)) :y 3}))

-;; this variable indicates that we are currently reverted to an earlier
-;; state of the branch and also which one we have reverted to
-(def reverted-to (atom -1))
-
 (defn revert-to [i]
   (prn "request revert: " i)
   (let [index (* (dec (len @(@current-branch :data))) (/ i 100))]
@@ -116,7 +116,9 @@
       (prn "revert to: " index)
       (reset! app-state state)
       (reset! reverted-to i)
-      (move-indicator-to i))))
+      (render-tree @app-history @current-branch (fn [branch] (switch-to-branch branch)) index)
+;      (move-indicator-to i)
+)))

 (defn add-new-branch [branch]
     (let [new-branch-morph (branch-morph
@@ -186,8 +188,8 @@
       (let [b @(@current-branch :data)]
         (when-not (= (last b) n)
           (append-to-branch (@current-branch :data) n))
-        (let [c (len @(@current-branch :data))]
-            (render-tree @app-history @current-branch (fn [branch] (switch-to-branch branch)))
+        (let [c (len b)]
+            (render-tree @app-history @current-branch (fn [branch] (switch-to-branch branch)) (* c (/ index 100)))
             (prn (str c " Saved " (pluralize c "State")))))))

 (om/root


New 'new' task that allows a template to be defined in ~/.cake/template.

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -3,7 +3,7 @@
         [cake.project :only [group]]
         [clojure.string :only [join]]
         [cake.utils.io :only [extract-resource]])
-  (:import [org.apache.tools.ant.taskdefs Mkdir]))
+  (:import [org.apache.tools.ant.taskdefs Mkdir Copy]))

 (def default-template
 "(defproject %s \"0.0.1-SNAPSHOT\"
@@ -11,25 +11,47 @@
   :dependencies [[clojure \"1.2.0\"]])
 ")

-(defn project-contents [project]
-  (let [template (file "~" ".cake" "project.template.clj")]
-    (format (if (.exists template) (slurp template) default-template) project)))
+(defn template-new [project]
+  (let [root (file *pwd* project)]
+    (if (.exists root)
+      (println "error:" project "already exists in this directory")
+      (do
+        (log "Creating a new project based on ~/.cake/template")
+        (ant Copy {:todir root} (add-fileset {:dir (str (file "~" ".cake" "template"))}))
+        (let [files (file-seq root)
+              rep (filter identity
+                          (map #(let [name (.getName %)
+                                      replaced (.replace name "+project+" project)]
+                                  (when (not= replaced name) [% (file (.getParent %) replaced)]))
+                               files))]
+          (log "Renaming directories with +project+ in their name")
+          (doseq [[from to] (sort-by (comp count str second) #(or (and (= % %2) 0) 1) rep)]
+            (.renameTo from to))
+          (let [files (file-seq root)]
+            (log (str "Replacing +project+ with '" project "' in all files."))
+            (doseq [f (filter #(.isFile %) files)]
+              (spit f (.replace (slurp f) "+project+" project)))))))))
+
+(defn default-new [project]
+  (let [root (file *pwd* project)]
+    (if (.exists root)
+      (println "error:" project "already exists in this directory")
+      (do (ant Mkdir {:dir root})
+          (ant Mkdir {:dir (file root "src")})
+          (ant Mkdir {:dir (file root "test")})
+          (spit (file root "project.clj") (format default-template project))
+          (log "Created file: project.clj")
+          (spit (file root ".gitignore")
+                (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" project] (repeat "\n"))))
+          (log "Created file: .gitignore")
+          (extract-resource "LICENSE" root)
+          (log "Created default LICENSE file (Eclipse Public License)")))))

 (deftask new
   "Create scaffolding for a new project."
-  "You can put a default project template in ~/.cake/project.template.clj with %s in place of the project name."
-  (let [project (symbol (first (:new *opts*)))
-        name    (name project)
-        root    (file *pwd* name)]
-    (if (.exists root)
-      (println "error:" name "already exists in this directory")
-      (do (ant Mkdir {:dir root})
-          (ant Mkdir {:dir (file root "src")})
-          (ant Mkdir {:dir (file root "test")})
-          (spit (file root "project.clj") (project-contents project))
-          (log "Created file: project.clj")
-          (spit (file root ".gitignore")
-                (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" name] (repeat "\n"))))
-          (log "Created file: .gitignore")
-          (extract-resource "LICENSE" root)
-          (log "Created default LICENSE file (Eclipse Public License)")))))
+  "You can put a default project template in ~/.cake/template. Substitute +project+ anywhere
+   that you want your project name to be."
+  [{[project] :new}]
+  (if (.exists (file "~" ".cake" "template"))
+    (template-new project)
+    (default-new project)))


upload works

upload works

--- src/celestial/sshj.clj
+++ src/celestial/sshj.clj
@@ -6,6 +6,8 @@
     [plumbing.core :only (defnk)]
     )
   (:import
+    (net.schmizz.sshj.common StreamCopier$Listener)
+    (net.schmizz.sshj.xfer FileSystemFile TransferListener)
     (net.schmizz.sshj SSHClient)
     (net.schmizz.sshj.userauth.keyprovider FileKeyProvider)
     (net.schmizz.sshj.transport.verification PromiscuousVerifier)
@@ -23,18 +25,45 @@
   [out]
   (doseq [line (line-seq (clojure.java.io/reader out))] (debug line)))

-(defnk session [host {user (@config :user)}]
+(defnk ssh-strap [host {user (@config :user)}]
   (let [ssh (SSHClient.)]
-     (.addHostKeyVerifier ssh (PromiscuousVerifier.))
-     (.loadKnownHosts ssh)
-     (.connect ssh host)
-     (.authPublickey ssh user #^"[Ljava.lang.String;" (into-array [(@config :key)]) )
-     (.startSession ssh)))
+    (.addHostKeyVerifier ssh (PromiscuousVerifier.))
+    (.loadKnownHosts ssh)
+    (.connect ssh host)
+    (.authPublickey ssh user #^"[Ljava.lang.String;" (into-array [(@config :key)]) )
+    ssh))

-(defn ssh-execute [cmd remote]
-   (let [session (session remote) res (.exec session cmd) ]
-     (debug cmd)
-     (log-output (.getInputStream res))))
+(defmacro with-ssh [remote & body]
+  `(let [~'ssh (ssh-strap ~remote)]
+     (try
+       ~@body
+       (catch Throwable e#
+         (error e#)
+         (.disconnect ~'ssh)))))

-; (ssh-execute "ping -c 1 google.com" {:host "localhost" :user "ronen"})
+(defn execute
+  "Executes a cmd on a remote host"
+  [cmd remote]
+  (with-ssh remote
+    (let [session (.startSession ssh) res (.exec session cmd) ]
+      (debug cmd)
+      (log-output (.getInputStream res)))))

+(def listener
+  (proxy [TransferListener] []
+    (directory [name*] (debug "starting to transfer" name*))
+    (file [name* size]
+      (proxy [StreamCopier$Listener ] []
+        (reportProgress [transferred]
+          (debug (<< "transferred ~(/ (* transferred 100) size)% of ~{name*}")))))))
+
+(defn upload [src dst remote]
+  (with-ssh remote
+    (let [scp (.newSCPFileTransfer ssh)]
+      (.setTransferListener scp listener)
+      (.upload scp (FileSystemFile. src) dst)
+      ))
+  )
+
+; (execute "ping -c 1 google.com" {:host "localhost" :user "ronen"})
+; (upload "/home/ronen/Downloads/PCBSD9.1-x64-DVD.iso" "/tmp" {:host "localhost" :user "ronen"})


Type hint ServletConfig parameter in init (to avoid reflecting to internal non-public classes in containers like Jetty)

--- webjure/src/webjure/servlet.clj
+++ webjure/src/webjure/servlet.clj
@@ -1,7 +1,7 @@
 (ns webjure.servlet
   (:refer-clojure)
   (:use webjure)
-  (:import (javax.servlet ServletException UnavailableException))
+  (:import (javax.servlet ServletConfig ServletException UnavailableException))
   (:import (javax.servlet.http
 	    HttpServlet HttpServletRequest HttpServletResponse))
   (:gen-class :name webjure.servlet.WebjureServlet
@@ -18,7 +18,7 @@

 (defn -init
   ([this] (.log this "Webjure servlet initialized."))
-  ([this config]
+  ([this ^ServletConfig config]
      (let [start-ns (.getInitParameter config "startupNamespace")]
        (when start-ns
 	 (require (symbol start-ns))))


Updated network group definition page

Updated network group definition page

--- src-cljs/arcis/pages/admin/network.cljs
+++ src-cljs/arcis/pages/admin/network.cljs
@@ -1,6 +1,6 @@
 ;;      Filename: network.cljs
 ;; Creation Date: Saturday, 29 August 2015 11:58 AM AEST
-;; Last Modified: Sunday, 18 October 2015 11:50 AM AEDT
+;; Last Modified: Sunday, 25 October 2015 09:39 AM AEDT
 ;;        Author: Tim Cross <theophilusx AT gmail.com>
 ;;   Description:
 ;;
@@ -34,7 +34,8 @@
       vmap)))

 (defn network-group-add [response]
-  (get-network-groups))
+  (get-network-groups)
+  (u/report-success (:message response)))

 (defn post-network-group [group]
   (if (state/is-authenticated?)
@@ -91,6 +92,6 @@

 (defn network-component []
   [:div
-   [network-group-table]
+   [add-network-group-component]
    [:hr]
-   [add-network-group-component]])
+   [network-group-table]])


Brain-Taping Warehouse.

Brain-Taping Warehouse.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -197,6 +197,11 @@
    "Brain Cage"
    {:effect (effect (damage :brain 1) (gain :max-hand-size 3))
     :leave-play (effect (lose :max-hand-size 3))}
+
+   "Brain-Taping Warehouse"
+   {:events {:pre-rez
+             {:req (req (and (= (:type target) "ICE") (has? target :subtype "Bioroid")))
+              :effect (effect (rez-cost-bonus (:click runner)))}}}

    "Braintrust"
    {:effect (effect (set-prop card :counter (quot (- (:advance-counter card) 3) 2)))


fix Gang Sign to work with HQ Interface

fix Gang Sign to work with HQ Interface

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -992,7 +992,7 @@

    "Gang Sign"
    {:events {:agenda-scored {:msg "access 1 card from HQ"
-                             :effect (req (let [c (first (shuffle (:hand corp)))]
+                             :effect (req (doseq [c (take (get-in @state [:runner :hq-access]) (shuffle (:hand corp)))]
                                             (system-msg state side (str "accesses " (:title c)))
                                             (handle-access state side [c])))}}}


Preserve with-launching-context return value

Also unquote body

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -36,14 +36,15 @@
                   clojure.repl/pst clj-stacktrace.repl/pst]
       (reader.jline/setup-reader! ~options)
       ~@body)
-    ~(if (resolve 'ex-info)
-       '(catch clojure.lang.ExceptionInfo e
-          (let [status# (:status (:object (ex-data e)))
-                body# (:body (:object (ex-data e)))]
-            (cond (= 401 status#) (println "Unauthorized.")
-                  (number? status#) (println "Remote error:" (slurp body))
-                  :else (clojure.repl/pst e)))))
-    (catch Throwable t# (clojure.repl/pst t#))
+    ~@(filter identity
+              [(when (resolve 'ex-info)
+                 `(catch clojure.lang.ExceptionInfo e#
+                    (let [status# (:status (:object (ex-data e#)))
+                          body# (:body (:object (ex-data e#)))]
+                      (cond (= 401 status#) (println "Unauthorized.")
+                            (number? status#) (println "Remote error:" (slurp ~body))
+                            :else (clojure.repl/pst e#)))))
+               '(catch Throwable t# (clojure.repl/pst t#))])
     (finally (exit/exit))))

 (defn set-prompt [options]


Added el-log helper.

Added el-log helper.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -41,6 +41,11 @@

 (def storage-max-inflight (atom 10))

+(defn el-log [el-prefix log-kind msg]
+  (set-el-innerHTML (str el-prefix "-" log-kind "-log")
+                    (str msg "\n"
+                         (get-el-innerHTML (str el-prefix "-" log-kind "-log")))))
+
 (defn world-vis-init [el-prefix]
   (let [kvs (atom {})
         changes (atom {})
@@ -52,9 +57,7 @@
                      (merge (map #(listen-el (gdom/getElement %) "click")
                                  (keys storage-cmd-handlers))))]
     (vis-init (fn [world]
-                (let [input-log (str el-prefix "-input-log")
-                      output-log (str el-prefix "-output-log")
-                      in-ch (achan-buf world 100)
+                (let [in-ch (achan-buf world 100)
                       out-ch (achan-buf world 0)]
                   (ago-loop a-input world [num-ins 0]
                             (let [cmd (<! cmd-ch)
@@ -68,16 +71,12 @@
                                                   (symbol (str ":" %2))
                                                   (get-el-value (str op "-" %2)))
                                                cmd2 params)]
-                              (set-el-innerHTML input-log
-                                                (str num-ins ": " cmd3 "\n"
-                                                     (get-el-innerHTML input-log)))
+                              (el-log el-prefix "input" (str num-ins ": " cmd3))
                               (aput a-input in-ch (handler cmd3))
                               (recur (inc num-ins))))
                   (ago-loop z-output world [num-outs 0]
                             (let [result (atake z-output out-ch)]
-                              (set-el-innerHTML output-log
-                                                (str num-outs ": " result "\n"
-                                                     (get-el-innerHTML output-log)))
+                              (el-log el-prefix "output" (str num-outs ": " result))
                               (recur (inc num-outs))))
                   (make-fenced-pump world in-ch out-ch @storage-max-inflight)))
               el-prefix nil)))


cleanup

cleanup

--- src/babel/francais/grammar.clj
+++ src/babel/francais/grammar.clj
@@ -441,8 +441,6 @@
 (defn analyze [arg]
   (morph/analyze arg lexicon))

-(def lookup (:lookup @small))
-
 (def medium
   (future
     (let [lexicon


fix typo

fix typo

--- src/babel/english/lexicon-verbcoach.clj
+++ src/babel/english/lexicon-verbcoach.clj
@@ -265,7 +265,7 @@
                                   :1plur "are born"
                                   :2plur "are born"
                                   :3plur "are born"}
-                                  :past-participle "been born}"}}
+                        :past-participle "been born"}}

    "be missed" {:synsem {:cat :verb
                          :sem {:pred :mancare}


(maint) test: add node-purge-ttl to query-options

--- test/puppetlabs/puppetdb/testutils/nodes.clj
+++ test/puppetlabs/puppetdb/testutils/nodes.clj
@@ -4,7 +4,7 @@
             [puppetlabs.puppetdb.examples :refer :all]
             [puppetlabs.puppetdb.zip :as zip]
             [puppetlabs.puppetdb.reports :as report]
-            [puppetlabs.puppetdb.time :refer [now plus seconds]]
+            [puppetlabs.puppetdb.time :refer [parse-period now plus seconds]]
             [puppetlabs.puppetdb.testutils.db :refer [*db*]]
             [puppetlabs.puppetdb.query-eng :as eng]))

@@ -108,4 +108,5 @@
                              ["from" "nodes" ["=" "certname" certname]]
                              {}
                              {:scf-read-db *db*
-                              :url-prefix "/pdb"})))+                              :url-prefix "/pdb"
+                              :node-purge-ttl (parse-period "14d")})))


Fix bug where a recipient list was not being added as a group.

--- src/clj/com/draines/postal/message.clj
+++ src/clj/com/draines/postal/message.clj
@@ -23,11 +23,14 @@
 (defn add-recipient! [jmsg rtype addr]
   (doto jmsg (.addRecipient rtype (InternetAddress. addr))))

+(defn add-recipients!* [jmsg rtype addrs]
+  (doto jmsg (.addRecipients rtype (into-array (map #(InternetAddress. %) addrs)))))
+
 (defn add-recipients! [jmsg rtype addrs]
-  (if (string? addrs)
-    (add-recipient! jmsg rtype addrs)
-    (doseq [addr addrs]
-      (add-recipient! jmsg rtype addr)))
+  (when addrs
+    (if (string? addrs)
+      (add-recipient! jmsg rtype addrs)
+      (add-recipients!* jmsg rtype addrs)))
   jmsg)

 (defn add-multipart! [jmsg parts]
@@ -75,11 +78,12 @@
 (deftest test-simple
   (let [m {:from "fee@bar.dom"
            :to "Foo Bar <foo@bar.dom>"
-           :cc ["baz@bar.dom" "quux@bar.dom"]
+           :cc ["baz@bar.dom" "Quux <quux@bar.dom>"]
            :date (java.util.Date.)
            :subject "Test"
            :body "Test!"}]
-    (is (= "Subject: Test" (re-find #"Subject: Test" (message->str m))))))
+    (is (= "Subject: Test" (re-find #"Subject: Test" (message->str m))))
+    (is (re-find #"Cc: baz@bar.dom, quux@bar.dom" (message->str m)))))

 (deftest test-multipart
   (let [m {:from "foo@bar.dom"


rename save button

rename save button

--- src/clj/hsm/controllers/discussion.clj
+++ src/clj/hsm/controllers/discussion.clj
@@ -161,13 +161,10 @@
                 :method :POST :data-redirect :true}
           [:div.form-group
             [:label "You said.."]
-
             [:textarea.form-control {:type :text :name :text
                                     :rows 10 :data-provide :markdown
                                     :data-iconlibrary :fa} (:text post)]]
-          [:button.btn.btn-success {:type :submit} "Start Discussion"]
-            ]]
-        )))
+          [:button.btn.btn-success {:type :submit} "Save"]]])))

 (defn post-discussion
   [{:keys [db event-chan redis conf]} request]


Sort encoded productions by title

Sort encoded productions by title

--- src/cljs/mdr2/productions/encoded.cljs
+++ src/cljs/mdr2/productions/encoded.cljs
@@ -90,7 +90,7 @@
 (rf/reg-sub
  ::productions-sorted
  :<- [::productions]
- (fn [productions] (->> productions (sort-by :id >))))
+ (fn [productions] (->> productions (sort-by :title))))

 (defn productions-filter []
   [:div.field.is-horizontal


Removed attempt at compositing support in the Images API.

--- src/appengine_magic/services/images.clj
+++ src/appengine_magic/services/images.clj
@@ -20,16 +20,16 @@
    :png ImagesService$OutputEncoding/PNG})

-(defonce *composite-anchor*
-  {:bottom Composite$Anchor/BOTTOM_CENTER
-   :bottom-left Composite$Anchor/BOTTOM_LEFT
-   :bottom-right Composite$Anchor/BOTTOM_RIGHT
-   :center Composite$Anchor/CENTER_CENTER
-   :center-left Composite$Anchor/CENTER_LEFT
-   :center-right Composite$Anchor/CENTER_RIGHT
-   :top Composite$Anchor/TOP_CENTER
-   :top-left Composite$Anchor/TOP_LEFT
-   :top-right Composite$Anchor/TOP_RIGHT})
+;; (defonce *composite-anchor*
+;;   {:bottom Composite$Anchor/BOTTOM_CENTER
+;;    :bottom-left Composite$Anchor/BOTTOM_LEFT
+;;    :bottom-right Composite$Anchor/BOTTOM_RIGHT
+;;    :center Composite$Anchor/CENTER_CENTER
+;;    :center-left Composite$Anchor/CENTER_LEFT
+;;    :center-right Composite$Anchor/CENTER_RIGHT
+;;    :top Composite$Anchor/TOP_CENTER
+;;    :top-left Composite$Anchor/TOP_LEFT
+;;    :top-right Composite$Anchor/TOP_RIGHT})

 (defrecord ImageHistogram [red green blue])
@@ -61,13 +61,6 @@
 ;;; ----------------------------------------------------------------------------
 ;;; transformations
 ;;; ----------------------------------------------------------------------------
-
-(defn composite* [image-arg offset-x offset-y opacity anchor-arg]
-  (let [image (get-image image-arg)
-        anchor (*composite-anchor* anchor-arg)]
-    (ImagesServiceFactory/makeComposite image (int offset-x) (int offset-y)
-                                        (float opacity) anchor)))
-

 (defn crop* [left-x top-y right-x bottom-y]
   (ImagesServiceFactory/makeCrop (double left-x) (double top-y)


Validation id & num

Validation id & num

--- src/clj/funstructor/cards_functions.clj
+++ src/clj/funstructor/cards_functions.clj
@@ -239,6 +239,12 @@
   :terminal-param
   [game-map player-key card & args]
   (let [[pos param & _] args]
+    (when (and (= (:terminal-id) card)
+               (not (base/id? param)))
+      (throw (IllegalArgumentException. "Not valid ID")))
+    (when (and (= (:terminal-num) card)
+               (not (base/num? param)))
+      (throw (IllegalArgumentException. "Not valid NUM")))
     ((apply-to-funstruct game-map player-key)
      (fn [funstruct]
        (assoc funstruct pos


Don't print a spurious newline after an exception.

Output was originally:

  user=> (/ 1 0)
  #<ArithmeticException java.lang.ArithmeticException: Divide by zero>

  user=>

--- src/clj/reply/eval_modes/standalone.clj
+++ src/clj/reply/eval_modes/standalone.clj
@@ -39,8 +39,8 @@
     ;lazyseq: (1 2 3 4 5 ...)
     ;pr: "(1 2 3 4 5 ...)"
     (when (not= failure-sentinel result)
-      (print-value result))
-    (when (:interactive options) (println))
+      (print-value result)
+      (when (:interactive options) (println)))
     (eval-state/get-ns-string)))

 (defn run-repl [{:keys [prompt subsequent-prompt history-file


handle passed in mouse handlers

handle passed in mouse handlers

--- src/cljs/infinitelives/pixi/sprite.cljs
+++ src/cljs/infinitelives/pixi/sprite.cljs
@@ -13,7 +13,9 @@
 (defn make-sprite
   "construct a sprite by its texture. optionally pass in other things"
   [texture & {:keys [x y xhandle yhandle scale alpha interactive mousedown
-                     rotation tint tiling tiling-width tiling-height visible]
+                     rotation tint tiling tiling-width tiling-height visible
+                     mousemove mousedown mouseup mouseupoutside
+                     touchmove touchdown touchup touchupoutside]
               :or {x 0 y 0
                    xhandle 0.5 yhandle 0.5
                    scale 1
@@ -38,9 +40,20 @@
               (make-point (get scale 0) (get scale 1)))))
     (when-not (= 1 alpha)
       (set! (.-alpha s) alpha))
-    (when-not (nil? interactive) (set! (.-interactive s) interactive))
-    (when-not (nil? mousedown) (set! (.-mousedown s) mousedown))
-    (when-not (nil? tint) (set! (.-tint s) tint))
+    (.setInteractive s (or mousemove mousedown mouseup mouseupoutside
+                           touchmove touchdown touchup touchupoutside))
+
+    (when mousedown (set! (.-mousedown s) mousedown))
+    (when mousemove (set! (.-mousemove s) mousemove))
+    (when mouseup (set! (.-mouseup s) mouseup))
+    (when mouseupoutside (set! (.-mouseupoutside s) mouseupoutside))
+
+    (when touchdown (set! (.-touchdown s) touchdown))
+    (when touchmove (set! (.-touchmove s) touchmove))
+    (when touchup (set! (.-touchup s) touchup))
+    (when touchupoutside (set! (.-touchupoutside s) touchupoutside))
+
+    (when tint (set! (.-tint s) tint))
     s))

 (defn set-pos!


Fix issue with next turn handling and baron effect

--- src/cljs/love_letter_cljs/handlers.cljs
+++ src/cljs/love_letter_cljs/handlers.cljs
@@ -86,7 +86,7 @@
 ;; For cycling turns
 (defn next-in-list [item-list current]
   (as-> item-list i
-    (drop-while #(not= current %) i)
+    (drop-while #(< current %) i)
     (or (first (next i))
         (first item-list))))


remove unnecesary mode

remove unnecesary mode

--- src/cljs/ohds/hierarchy/processing.cljs
+++ src/cljs/ohds/hierarchy/processing.cljs
@@ -28,12 +28,12 @@
           expected-level-count (count (:hierarchy-levels app))]
       (if (= selected-level-count
              expected-level-count)
-        (assoc app :page :location :mode :census)
+        (assoc app :page :locations)
         (assoc app :errors "Please select all hierarchies"))))
   m/StartVisit
   (process-message
       [message app]
-    (assoc app :hierarchy (hierarchy app) :page :location-select :mode :visit))
+    (assoc app :hierarchy (hierarchy app) :page :location-select))
   m/LocationsForHierarchyResults
   (process-message
       [message app]


Add context construction caching.

Add context construction caching.

This optimization enables the catacumba context construction
caching, so avoid do unnecesary work building it on each handler
chain execution.

--- src/clojure/catacumba/impl/handlers.clj
+++ src/clojure/catacumba/impl/handlers.clj
@@ -221,33 +221,39 @@
 ;; Adapters Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-;; TODO: Remove repeated context building accross handlers
-;; delegation process.
-;; (defrecord InternalCache [payload])
-;; (alter-meta! #'->InternalCache assoc :private true)
-;; (alter-meta! #'map->InternalCache assoc :private true)
-
 (defn hydrate-context
   {:internal true :no-doc true}
-  [^Context ctx callback]
-  (letfn [(continuation [^DefaultContext context ^TypedData body]
-            (let [context (assoc context :body body)]
-              (callback (merge context (ct/get-context-params* ctx)))))]
-    (let [^Request request (.getRequest ctx)
-          ^Response response (.getResponse ctx)
-          ^Promise promise (.getBody request)
-          contextdata {:catacumba/context ctx
-                       :catacumba/request request
-                       :catacumba/response response
-                       :path (str "/" (.getPath request))
-                       :query (.getQuery request)
-                       :method (keyword (.. request getMethod getName toLowerCase))
-                       :query-params (ct/get-query-params* request)
-                       :route-params (ct/get-route-params* ctx)
-                       :cookies (ct/get-cookies* request)
-                       :headers (ct/get-headers* request true)}
-          context (ct/context contextdata)]
-      (hp/then promise (partial continuation context)))))
+  [^Context ctx next]
+  (letfn [(build-context [^Context ctx next]
+            (let [^Request request (.getRequest ctx)
+                  ^Response response (.getResponse ctx)
+                  contextdata {:catacumba/context ctx
+                               :catacumba/request request
+                               :catacumba/response response
+                               :path (str "/" (.getPath request))
+                               :query (.getQuery request)
+                               :method (keyword (.. request getMethod getName toLowerCase))
+                               :query-params (ct/get-query-params* request)
+                               :route-params (ct/get-route-params* ctx)
+                               :cookies (ct/get-cookies* request)
+                               :headers (ct/get-headers* request true)}
+                  context (ct/context contextdata)]
+              (hp/then (.getBody request)
+                       (fn [^TypedData body]
+                         (next (assoc context :body body))))))
+
+          (retrieve-context [^Context ctx next]
+            (let [^Request request (.getRequest ctx)
+                  ^Optional odata (.maybeGet request DefaultContext)]
+              (if (.isPresent odata)
+                (next (.get odata))
+                (build-context ctx #(cache-context request % next)))))
+
+          (cache-context [^Request request ^DefaultContext context next]
+            (.add request DefaultContext context)
+            (next context))]
+    (retrieve-context ctx (fn [^DefaultContext context]
+                            (next (merge context (ct/get-context-params* ctx)))))))

 (defmethod adapter :catacumba/default
   [handler]


Fix metadata table filters

Fix metadata table filters

--- src/clojure/ch/hood/odpg/impl/expdp.clj
+++ src/clojure/ch/hood/odpg/impl/expdp.clj
@@ -28,6 +28,11 @@
 				 "value => 'IN (" schema-names ")'"
 				 ");")))

+(defn filter-type-operator [filter-type]
+	(case filter-type
+		:include-tables "IN"
+		:exclude-tables "NOT IN"))
+
 (defn render-table-metadatafile
 	([ctx filter-type table-names]
 	 (let [table-names (map double-quote table-names)
@@ -35,14 +40,15 @@
 		 (str "dbms_datapump.metadata_filter("
 					"handle => handle, "
 					"name => 'NAME_EXPR', "
-					"value => 'IN (" table-names ")', "
+					"value => '" (filter-type-operator filter-type) " (" table-names ")', "
 					"object_type => 'TABLE'"
 					");")))
 	([ctx schemas]
 		;; if we come here, we have the guarantee of a single schema mode. see validate.
 	 (let [filter-types [:include-tables :exclude-tables]
 				 tables ((apply juxt filter-types) (get schemas (-> schemas keys first)))
-				 tables (map #(render-table-metadatafile ctx %1 %2) filter-types tables)]
+				 tables (map #(when (not (nil? %2)) (render-table-metadatafile ctx %1 %2)) filter-types tables)
+				 tables (filter (comp not nil?) tables)]
 		 (str/join "\n" tables))))

 (defn render-subquery-datafilter [ctx schema-name table-name subquery]
@@ -152,4 +158,4 @@
 																						 "BOOKING_DELTA"  "WHERE Pth = 231"
 																						 })

-	(render-schema-metadatafilter nil (:schemas input)))+	(render-schema-metadatafilter nil (:schemas input)))


Try to avoid selecting parents with empty genomes in autoconstruction.

--- src/clojush/pushgp/parent_selection.clj
+++ src/clojush/pushgp/parent_selection.clj
@@ -1,3 +1,6 @@
+;; gorilla-repl.fileformat = 1
+
+;; @@
 (ns clojush.pushgp.parent-selection
   (:use [clojush random globals util])
   (:require [clojure.set :as set]))
@@ -31,11 +34,22 @@
   "Retains one random individual to represent each error vector."
   [pop]
   (map lrand-nth (vals (group-by #(:errors %) pop))))
+
+(defn possibly-remove-individuals-with-empty-genomes
+  "When :autoconstuctive is truthy, and at least one individual in pop has a non-empty
+  genome, remove those with empty genomes."
+  [pop {:keys [autoconstructive]}]
+  (if autoconstructive
+    (let [with-non-empty-genomes (filter #(not (empty? (:genome %))) pop)]
+      (if (not (empty? with-non-empty-genomes))
+        with-non-empty-genomes
+        pop))
+    pop))

 (defn lexicase-selection
   "Returns an individual that does the best on the fitness cases when considered one at a
    time in random order.  If trivial-geography-radius is non-zero, selection is limited to parents within +/- r of location"
-  [pop location {:keys [trivial-geography-radius]}]
+  [pop location {:keys [trivial-geography-radius] :as argmap}]
   (let [lower (mod (- location trivial-geography-radius) (count pop))
         upper (mod (+ location trivial-geography-radius) (count pop))
         popvec (vec pop)
@@ -45,7 +59,9 @@
                    (subvec popvec lower (inc upper))
                    (into (subvec popvec lower (count pop))
                          (subvec popvec 0 (inc upper)))))]
-    (loop [survivors (retain-one-individual-per-error-vector subpop)
+    (loop [survivors (retain-one-individual-per-error-vector
+                       (possibly-remove-individuals-with-empty-genomes
+                         subpop argmap))
            cases (lshuffle (range (count (:errors (first subpop)))))]
       (if (or (empty? cases)
               (empty? (rest survivors)))
@@ -176,3 +192,5 @@
                                                                1
                                                                (inc sel-count)))))
     selected))
+
+;; @@


Fill in manga reader's page link scraping

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -47,5 +47,8 @@
       :page-list-data-for-comic-chapter
       (fn [chapter-url]
         {:url chapter-url
-         :selector [:div]
-         :normalize link->map})})])
+         :selector [:div#selectpage :select#pageMenu :option]
+         :normalize (fn [{[name]       :content
+                          {url :value} :attrs}]
+                      {:name name
+                       :url (str canonical-url url)})})})])


Add RunnerProtocol support to new version

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -146,19 +146,20 @@
   (let [cs       (repeatedly concurrency async/chan)
         ps       (map vector (iterate inc 0) cs)
         results  (async/chan)
-        requests (-> scenario :requests)]
+        requests (-> scenario :requests)
+        scenario-start (local-time/local-now)]
     (doseq [[user-id c] ps]
       (run-requests requests timeout user-id c))
     (go-loop [^long i 0]
       (let [[result c] (alts! cs)]
-        (when (< i (- number-of-requests concurrency))
+        (when (continue-run? runner scenario-start (+ i concurrency))
           (run-requests requests timeout (+ i concurrency) c))
         (>! results {:name (:name scenario)
                      :id (:id (first result))
                      :start (:start (first result))
                      :end (:end (last result))
                      :requests result})
-        (when (<= i number-of-requests)
+        (when (continue-run? runner scenario-start i)
           (recur (inc i)))))
     (repeatedly number-of-requests #(<!! results))))


Replace missing translations with keys

Replace missing translations with keys

Signed-off-by: Antti Koskinen <7180a8b2eda8ec34b3486f8aa865046413c11ed3@discendum.com>

--- src/cljc/salava/core/i18n.cljc
+++ src/cljc/salava/core/i18n.cljc
@@ -15,6 +15,8 @@
 (def translation (tower/make-t tconfig)) ; create translation fn

 (defn t [key]
-  (let [lang #?(:clj "en"
-                :cljs (session/get :lang))]
-    (translation lang key)))
+  (let [lang #?(:clj "en" :cljs (session/get :lang))
+        out-str (translation lang key)]
+    (if-not (= out-str "")
+      out-str
+      (str "[" key "]"))))


Card limit on hand

Card limit on hand

--- src/clj/funstructor/cards_functions.clj
+++ src/clj/funstructor/cards_functions.clj
@@ -5,6 +5,7 @@
    [funstructor.cards :as c]))

 (def start-cards-num 6)
+(def card-limit-on-hand 10)
 (def cards-per-turn 2)

 (defn log-message [game message]
@@ -105,7 +106,12 @@
   "Add card to player state"
   [game-map player-key card]
   ((apply-to-cards game-map player-key)
-   (fn [v] (conj v card))))
+   (fn [v]
+     (if (< (count v) card-limit-on-hand)
+       (conj v card) ;; just add card
+       (-> v
+           (u/delete-from-vector (rand-int (count v)))
+           (conj card))))))

 (defn take-cards [game-map player-key num]
   (reduce


stray println removed

stray println removed

--- src/cljs/hatti/map/viewby.cljs
+++ src/cljs/hatti/map/viewby.cljs
@@ -144,9 +144,6 @@
   [answer->selected? visible-answers answer]
   (let [all-answers (vals answer->selected?)
         all-visible-selected? (fn [a->s visible]
-                                (println (clj->js {:a->s a->s :visible visible
-                                                   :filtered (->> a->s (filter second) keys set)
-                                                   :svis (set visible)}))
                                 (= (set visible)
                                    (->> a->s (filter second) keys set)))]
     (if (nil? answer)


Use new function name.

Use new function name.

--- src/clj/mx/roads/forgotten/blog/cli.clj
+++ src/clj/mx/roads/forgotten/blog/cli.clj
@@ -43,11 +43,11 @@
     $ frmx gen help
   ```"
   [[cmd & args]]
-  (logger/set-level! ['ngap.onboarding] :info)
+  (logger/set-level! ['mx.roads.forgotten.blog] :info)
   (log/debug "Got cmd:" cmd)
   (log/debug "Got args:" args)
   (case cmd
-    :config (pprint (config/lookup))
+    :config (pprint (config/blog))
     :gen (generator/run args)
     :run (web/run)
     :help (help-cmd args)


Added save to app db from editor fields on change

--- src/cljs/modern_cljs/core.cljs
+++ src/cljs/modern_cljs/core.cljs
@@ -24,7 +24,8 @@

 (def db
   {:var (str "tosi:" (rand-int 10))
-   :start 10})
+   :start 10
+   :editing {}})

 (defn ^:export updatedb [fields value]
   (set! db (assoc-in db fields value))
@@ -49,12 +50,24 @@
 (defn setpage [next]
   (updatedb [:start] next))

+(defn update_field [id value]
+  (println "Updating" id value)
+  (set! db (assoc-in db [:editing id] value)))
+
+(defn save []
+  (println "Saved!"))
+
+(defn clear []
+  (println "Cleared!"))
+
 ;
 ; View
 ;

-(defn text [value]
-  (m "input[type=text]" {:value value} nil))
+(defn text [id value]
+  (m "input[type=text]"
+     {:value value :onchange #(update_field id (-> % .-target .-value))}
+     nil))

 (defn editor [data]
   (let [title (get data "title" "")
@@ -70,13 +83,13 @@
             (m "td" nil "Comment")
             (m "td" nil "Time")
             (m "td" nil "")])
-        (m "tr" nil [(m "td" nil (text title))
-                     (m "td" nil (text url))
-                     (m "td" nil (text referer))
-                     (m "td" nil (text comment))
-                     (m "td" nil (text time))
-                     (m "td#edit" nil [(m "button" nil "Save")
-                                  (m "button" nil "Clear")])])])))
+        (m "tr" nil [(m "td" nil (text "title" title))
+                     (m "td" nil (text "url" url))
+                     (m "td" nil (text "referer" referer))
+                     (m "td" nil (text "comment" comment))
+                     (m "td" nil (text "time" time))
+                     (m "td#edit" nil [(m "button" {:onclick #(save)} "Save")
+                                  (m "button" {:onclick #(clear)} "Clear")])])])))

 (defn notes [data start]
   "Returns 10 items from data"
@@ -104,13 +117,14 @@
     (m "div" nil ["Count: " count " " (page start - count) " " (page start + count)])))

 (defn ctrl []
-  (println "Calling major Tom")
-  (fetch "/data.json"))
+  (if (not (:data db nil))
+    (do (println "Calling major Tom")
+        (fetch "/data.json"))))

 (defn viewer [c]
   (m "div" nil
      [(m "h1" {:style {:color "green"}} (:var db))
-      (editor {})
+      (editor (:editing db))
       (m "div" {} [(m "ol" nil (notes (:data db) (:start db)))])
       (pages)]))


make playlist page more similar to old site

--- src/cljs/daveconservatoire/site/ui.cljs
+++ src/cljs/daveconservatoire/site/ui.cljs
@@ -365,9 +365,12 @@
         (dom/div #js {:className "container wrapper"}
           (dom/div #js {:className "inner_content"}
             (dom/div #js {:className "row"}
-              (testimonial {:quote "Watching your videos made music seem a lot less like sorcery, they do make it much more magical though." :person "Kristian Theisson, Dave Conservatoire student"})
-              (testimonial {:quote "Wishing you all the best with Dave Conservatoire. I'll be sure to share it with my colleagues." :person "Martin Bean, Vice Chancellor, Open University"})
-              (testimonial {:quote "The stuff you're doing is super cool! I hope we get the chance to meet and/or collaborate in the not-too-far-off future." :person "Salman Khan, Founder, Khan Academy"}))))
+              (testimonial {:quote  "Watching your videos made music seem a lot less like sorcery, they do make it much more magical though."
+                            :person "Kristian Theisson, Dave Conservatoire student"})
+              (testimonial {:quote  "Wishing you all the best with Dave Conservatoire. I'll be sure to share it with my colleagues."
+                            :person "Martin Bean, Vice Chancellor, Open University"})
+              (testimonial {:quote  "The stuff you're doing is super cool! I hope we get the chance to meet and/or collaborate in the not-too-far-off future."
+                            :person "Salman Khan, Founder, Khan Academy"}))))
         (get-started)))))

 (defmethod r/route->component ::r/about [_] AboutPage)
@@ -690,10 +693,42 @@
       (om/set-state! c {:reported? true})
       (om/transact! (om/get-reconciler c) `[(lesson/save-view {:db/id ~id})]))))

+(om/defui ^:once SiblingLessonQuery
+  static om/Ident
+  (ident [_ props] (u/model-ident props))
+
+  static om/IQuery
+  (query [_] [:db/table :db/id :url/slug]))
+
+(om/defui ^:once LessonPagination
+  static om/IQuery
+  (query [_] [:db/id :db/table
+              {:lesson/prev (om/get-query SiblingLessonQuery)}
+              {:lesson/next (om/get-query SiblingLessonQuery)}])
+
+  static om/Ident
+  (ident [_ props] (u/model-ident props))
+
+  Object
+  (render [this]
+    (let [{:lesson/keys [prev next]} (om/props this)]
+      (dom/ul #js {:className "pager"}
+        (dom/li #js {:className "previous"}
+          (if (seq prev)
+            (link {::r/handler ::r/lesson ::r/params {::r/slug (:url/slug prev)}}
+              "Previous")))
+        (dom/li #js {:className "next"}
+          (if (seq next)
+            (link {::r/handler ::r/lesson ::r/params {::r/slug (:url/slug next)}}
+              "Next")))))))
+
+(def lesson-pagination (om/factory LessonPagination))
+
 (om/defui ^:once LessonVideo
   static om/IQuery
   (query [_] [:db/id :lesson/type :lesson/description :youtube/id
-              {:lesson/topic (om/get-query LessonTopicMenu)}])
+              {:lesson/topic (om/get-query LessonTopicMenu)}
+              {:ph/pagination (om/get-query LessonPagination)}])

   Object
   (initLocalState [_] {:reported? false})
@@ -701,7 +736,7 @@
   (componentWillReceiveProps [this _] (om/set-state! this {:reported? false}))

   (render [this]
-    (let [{:keys [lesson/description lesson/topic youtube/id] :as props} (om/props this)]
+    (let [{:keys [lesson/description lesson/topic youtube/id ph/pagination]} (om/props this)]
       (container
         (dom/div #js {:className "row"}
           (dom/div #js {:className "span3"}
@@ -712,7 +747,8 @@
                 (ytp/youtube-player (om/computed {:videoId id}
                                                  {:on-state-change #(if %2 (report-video-play this))})))
               (dom/div #js {:className "well"}
-                description))))))))
+                description))
+            (lesson-pagination pagination)))))))

 (def lesson-video (om/factory LessonVideo))

@@ -728,9 +764,13 @@
     (let [{:keys [youtube/id playlist-item/title playlist-item/text]} (om/props this)]
       (dom/div nil
         (dom/div #js {:className "vendor"} (ytp/youtube-player {:videoId id}))
-        (dom/div #js {:className "well"}
-          (dom/div nil title)
-          (dom/div nil text))))))
+        (dom/div #js {:className "classroom-slider coda-slider-wrapper arrows" :style #js {:padding 0}}
+          (dom/div #js {:style {:width 20}})
+          (dom/div #js {:className "coda-slider" :style {:height 169}}
+            (dom/div #js {:className "panel" :style {:display "block"}}
+              (dom/div #js {:className "panel-wrapper"}
+                (dom/h2 #js {:className "title"} title)
+                (dom/p nil text)))))))))

 (def lesson-playlist-item (om/factory LessonPlaylistItem))

@@ -738,11 +778,13 @@
   static om/IQuery
   (query [_] [:lesson/type :lesson/description :ui/selected-index :db/id
               {:lesson/playlist-items (om/get-query LessonPlaylistItem)}
-              {:lesson/topic (om/get-query LessonTopicMenu)}])
-
-  Object
-  (render [this]
-    (let [{:keys [db/id lesson/topic lesson/type lesson/playlist-items ui/selected-index]} (om/props this)
+              {:lesson/topic (om/get-query LessonTopicMenu)}
+              {:ph/pagination (om/get-query LessonPagination)}])
+
+  Object
+  (render [this]
+    (let [{:keys [db/id lesson/topic lesson/type lesson/playlist-items ui/selected-index
+                  ph/pagination]} (om/props this)
           selected-index (or selected-index 0)
           item (nth (vec playlist-items) selected-index)
           set-selected (fn [n]
@@ -758,11 +800,21 @@
             (dom/div #js {:className "lesson-content"}
               (if item
                 (lesson-playlist-item item))
-              (dom/div nil
-                (dom/button #js {:onClick  #(set-selected (dec selected-index))
-                                 :disabled (= 0 selected-index)} "<<")
-                (dom/button #js {:style    #js {:float "right"} :onClick #(set-selected (inc selected-index))
-                                 :disabled (= (dec (count playlist-items)) selected-index)} ">>")))))))))
+              (dom/div #js {:className "classroom-slider coda-slider-wrapper arrows" :style #js {:padding 0}}
+                (dom/div #js {:className "coda-nav-left", :id "coda-nav-left-1"}
+                  (dom/a #js {:href     "#"
+                              :onClick  #(set-selected (dec selected-index))
+                              :disabled (= 0 selected-index)}
+                    "«"))
+                (dom/div #js {:className "coda-slider", :id "coda-slider-1", :style {:height 169}}
+                  (dom/div #js {:className "panel", :style {:display "block"}}
+                    (dom/div #js {:className "panel-wrapper"})))
+                (dom/div #js {:className "coda-nav-right", :id "coda-nav-right-1"}
+                  (dom/a #js {:href     "#"
+                              :onClick  #(set-selected (inc selected-index))
+                              :disabled (= (dec (count playlist-items)) selected-index)}
+                    "»"))))
+            (lesson-pagination pagination)))))))

 (def lesson-playlist (om/factory LessonPlaylist))

@@ -774,7 +826,8 @@
   static om/IQuery
   (query [_] [:lesson/type :lesson/title :url/slug :db/id
               {:exercise/data '?exercise/data}
-              {:lesson/topic (om/get-query LessonTopicMenu)}])
+              {:lesson/topic (om/get-query LessonTopicMenu)}
+              {:ph/pagination (om/get-query LessonPagination)}])

   Object
   (componentDidMount [this]
@@ -789,7 +842,7 @@
           (om/transact! r [type id] [`(ui/set-props {:exercise/data ~ident})])))))

   (render [this]
-    (let [{:keys [lesson/topic url/slug exercise/data]} (om/props this)
+    (let [{:keys [lesson/topic url/slug exercise/data ph/pagination]} (om/props this)
           {:keys [::ux/class]} (ux/slug->exercise slug)]
       (container
         (dom/div #js {:className "row"}
@@ -799,7 +852,8 @@
             (if class
               (when (get data ::ux/streak-count)
                 ((om/factory class) data))
-              (str "Exercice [" slug "] not implemented"))))))))
+              (str "Exercice [" slug "] not implemented"))
+            (lesson-pagination pagination)))))))

 (def lesson-exercise (om/factory LessonExercise))


Remove unused require

Remove unused require

--- src/cljs/potok_rumu/store.cljs
+++ src/cljs/potok_rumu/store.cljs
@@ -1,7 +1,5 @@
 (ns potok-rumu.store
-  (:require [rum.core :as rum]
-            [potok.core :as ptk]))
-
+  (:require [potok.core :as ptk]))

 (defonce initial-state
   {:state {:state/potok 0 :state/in-pub? false}})