+(defn arrabbiarsi)

+(defn arrabbiarsi)

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -284,6 +284,78 @@
                         babel.generate/grammar grammar]
                 (time (generate spec model))))))))

+
+(defn arrabbiarsi
+  "generate arrabiarsi sentences with a grammar subset."
+  []
+  (let [grammar
+        (filter
+         #(contains?
+           #{"s-aux"
+             "s-conditional-nonphrasal"
+             "s-conditional-phrasal"
+             "s-future-nonphrasal"
+             "s-future-phrasal"
+             "s-imperfetto-nonphrasal"
+             "s-imperfetto-phrasal"
+             "s-present-nonphrasal"
+             "s-present-phrasal"
+             "vp-aux-22-nonphrasal-comp"
+             "vp-aux-phrasal-complement"
+             "vp-aux-nonphrasal-complement"
+             "vp-32"
+             "vp-pronoun-nonphrasal"
+             "vp-pronoun-phrasal"} (u/get-in % [:rule]))
+         (:grammar model))
+        spec {:root {:italiano {:italiano "arrabbiarsi"}}
+              :synsem {:cat :verb
+                       :modified false
+                       :sem {:tense :past
+                             :aspect :progressive}
+                       :subcat []}}]
+    (repeatedly
+     #(println
+       (morph-ps (binding [babel.generate/println? false
+                           babel.generate/truncate? false
+                           babel.generate/grammar grammar]
+                   (time (generate spec model))))))))
+
+(defn stampare
+  "generate arrabiarsi sentences with a grammar subset."
+  []
+  (let [grammar
+        (filter
+         #(contains?
+           #{"s-aux"
+             "s-conditional-nonphrasal"
+             "s-conditional-phrasal"
+             "s-future-nonphrasal"
+             "s-future-phrasal"
+             "s-imperfetto-nonphrasal"
+             "s-imperfetto-phrasal"
+             "s-present-nonphrasal"
+             "s-present-phrasal"
+             "vp-aux-22-nonphrasal-comp"
+             "vp-aux-phrasal-complement"
+             "vp-aux-nonphrasal-complement"
+             "vp-32"
+             "vp-pronoun-nonphrasal"
+             "vp-pronoun-phrasal"} (u/get-in % [:rule]))
+         (:grammar model))
+        spec {:root {:italiano {:italiano "stampare"}}
+              :synsem {:cat :verb
+                       :modified false
+                       :sem {:tense :past
+                             :obj :unspec
+                             :aspect :progressive}
+                       :subcat []}}]
+    (repeatedly
+     #(println
+       (morph-ps (binding [babel.generate/println? false
+                           babel.generate/truncate? false
+                           babel.generate/grammar grammar]
+                   (time (generate spec model))))))))
+
 (defn chiamarsi-ps
   "generate chiamarsi sentences with parse trees"
   []


Fix destructuring

Fix destructuring

--- src/braid/server/events.clj
+++ src/braid/server/events.clj
@@ -23,8 +23,8 @@

 (defn register-user!
   [email group-id]
-  (let [user (db/run-txns! (user/create-user-txn {:id (db/uuid)
-                                                  :email email}))]
+  (let [[user] (db/run-txns! (user/create-user-txn {:id (db/uuid)
+                                                    :email email}))]
     (user-join-group! (user :id) group-id)
     (user :id)))


Fixed issue #5

Fixed issue #5

--- src/branch_handler/core.clj
+++ src/branch_handler/core.clj
@@ -246,9 +246,9 @@
 (defn create-workdir
   [workdir]
   (let [directory (new java.io.File workdir)]
-    (when (not (.isDirectory directory))
+    (when-not (.isDirectory directory))
       (log/info "Creating work directory" (.getAbsolutePath directory))
-      (.mkdir directory))))
+      (.mkdir directory)))

 (defn -main
   "Entry point to the branch handler service server."


adding clear

adding clear


move /accept route ahead of /* catch-all

--- src/chat/server/handler.clj
+++ src/chat/server/handler.clj
@@ -20,6 +20,13 @@
    :body (pr-str clj-body)})

 (defroutes site-routes
+  (GET "/accept" [invite tok]
+    (if (and invite tok)
+      (if-let [invite (db/with-conn (db/get-invite (java.util.UUID/fromString invite)))]
+        {:status 200 :headers {"Content-Type" "text/html"} :body (invites/register-page invite tok)}
+        {:status 400 :headers {"Content-Type" "text/plain"} :body "Invalid invite"})
+      {:status 400 :headers {"Content-Type" "text/plain"} :body "Bad invite link, sorry"}))
+
   (GET "/*" []
     (let [replacements {"{{algo}}" "sha256"
                         "{{css}}" (digest/from-file "/css/out/chat.css")
@@ -30,12 +37,6 @@
                    slurp)]
       (string/replace html #"\{\{\w*\}\}" replacements)))

-  (GET "/accept" [invite tok]
-    (if (and invite tok)
-      (if-let [invite (db/with-conn (db/get-invite (java.util.UUID/fromString invite)))]
-        {:status 200 :headers {"Content-Type" "text/html"} :body (invites/register-page invite tok)}
-        {:status 400 :headers {"Content-Type" "text/plain"} :body "Invalid invite"})
-      {:status 400 :headers {"Content-Type" "text/plain"} :body "Bad invite link, sorry"}))
   (POST "/register" [token invite_id password email now hmac nickname avatar :as req]
     (let [fail {:status 400 :headers {"Content-Type" "text/plain"}}]
       (cond


When registering, send greeting to the robot

--- src/clj/lauranne/server.clj
+++ src/clj/lauranne/server.clj
@@ -21,14 +21,22 @@

 (defn register [{:keys [body] :as req}]
   (let [db (mg/get-db conn "test")
-        visitor (json/parse-stream (clojure.java.io/reader body))]
+        visitor body
+        message (str "Tervetuloa " (get visitor "name"))]
     (println "registering:" visitor)
-    (mc/insert db "visitors" visitor))
+    (mc/insert db "visitors" visitor)
+    (client/post (str "http://" (System/getenv "ROBOT_IP") ":3000/say")
+                 {:content-type :json
+                  :throw-exceptions false
+                  :body (json/generate-string {:message message})}))
    {:status 201})

 (defn say [{:keys [body]}]
-  (println (get body "message"))
-  (client/post "http://192.168.103.34:3000/say" {:content-type :json :body (json/generate-string {:message (get body "message")})})
+  (println "Greeting:" (get body "message"))
+  (client/post (str "http://" (System/getenv "ROBOT_IP") ":3000/say")
+               {:content-type :json
+                :throw-exceptions false
+                :body (json/generate-string {:message (get body "message")})})
   {:status 200})

 (defroutes app


environment vars are immutable

environment vars are immutable

--- src/clj/swarmpit/config.clj
+++ src/clj/swarmpit/config.clj
@@ -6,11 +6,11 @@
               :docker-api  "v1.28"
               :db-url      "http://localhost:5984"})

-(defn environment
-  [] (->> {:docker-sock (env :swarmpit-docker-sock)
-           :docker-api  (env :swarmpit-docker-api)
-           :db-url      (env :swarmpit-db)}
-          (into {} (remove #(nil? (val %))))))
+(def environment
+  (->> {:docker-sock (env :swarmpit-docker-sock)
+        :docker-api  (env :swarmpit-docker-api)
+        :db-url      (env :swarmpit-db)}
+       (into {} (remove #(nil? (val %))))))

 (def ^:private dynamic (atom {}))

@@ -18,6 +18,6 @@
   [config] (reset! dynamic config))

 (defn config
-  ([] (->> [default (environment) @dynamic]
-          (apply merge)))
+  ([] (->> [default environment @dynamic]
+           (apply merge)))
   ([key] ((config) key)))


factor out screen

factor out screen

--- src/cljs/relembra/core.cljs
+++ src/cljs/relembra/core.cljs
@@ -154,11 +154,15 @@
                        (set0! :drawer/open false :screen/current :add-lembrando))}
       "Acrescenta pergunta"]]))

-(defn add-lembrando []
+(defn screen [title contents]
   [:div
-   [rui/app-bar {:title "Acrescenta pergunta"
+   [rui/app-bar {:title title
                  :on-left-icon-button-touch-tap open-drawer}]
    [drawer]
+   contents])
+
+(defn add-lembrando []
+  [screen "Acrescenta pergunta"
    [:div.container
     [md-editor "Pergunta" :addq/question-text]
     [md-editor "Resposta" :addq/answer-text]
@@ -178,10 +182,7 @@

 (defn welcome []
   (let [lembrandos (d/q '[:find [?l ...] :where [?l :lembrando/question]] @conn)]
-    [:div
-     [rui/app-bar {:title "Bem vindo!"
-                   :on-left-icon-button-touch-tap open-drawer}]
-     [drawer]
+    [screen "Bem vindo!"
      (if (> (count lembrandos) 0)
        [:div "Tes lembrandos!"]
        [:div "Nom tes!"])]))


fix deleting temp goal

fix deleting temp goal

--- src/cljs/tictag/events.cljs
+++ src/cljs/tictag/events.cljs
@@ -350,12 +350,10 @@
  [interceptors]
  (fn [{:keys [db]} [_ id]]
    (merge
-    {:db (let [{:keys [user beeminder]} (get-in db [:goal/by-id id])]
+    {:db (let [old (get-in db [:goal/by-id id])]
            (-> db
-               (assoc-in [:goal/by-id id :_old-user] user)
-               (assoc-in [:goal/by-id id :_old-beeminder] beeminder)
-               (assoc-in [:goal/by-id id :user] nil)
-               (assoc-in [:goal/by-id id :beeminder] nil)))}
+               (assoc-in [:goal/by-id id] nil)
+               (assoc-in [:db/trash :goal/by-id id] old)))}
     (when (not= :temp id)
       {:http-xhrio (authenticated-xhrio
                     {:uri             (str "/api/user/me/goals/" id)
@@ -371,9 +369,8 @@
  :goal/delete-fail
  [interceptors]
  (fn [db [_ id result]]
-   (update-in db [:goal/by-id id]
-              (fn [{:keys [_old-user _old-beeminder] :as goal}]
-                (assoc goal :user _old-user :beeminder _old-beeminder)))))
+   (let [old (get-in db [:db/trash :goal/by-id id])]
+     (assoc-in db [:goal/by-id id] old))))

 (reg-event-fx
  :goal/save


Init board

Init board

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -23,20 +23,19 @@
           y (range board-height)]
       [x y])))

-(defn random-positions
-  "Draw n * m distincts random position"
-  [n m]
-  (let [pos (shuffle all-positions)
-        cut #(subvec pos (* % n) (* (inc %) n))]
-    (map cut (range m))))
+(defn draw-slices
+  "Draw n * m slices from the collection"
+  [n m positions]
+  (map
+    (fn [k] (subvec positions (* k n) (* (inc k) n)))
+    (range m)))

 (defn init-positions
+  "Create random initial positions for the players"
   []
-  (let [pos (random-positions init-block-count 4)]
-    {:blue (nth pos 0)
-     :red (nth pos 1)
-     :green (nth pos 2)
-     :gray (nth pos 3)}))
+  (->> (shuffle all-positions)
+       (draw-slices init-block-count 4)
+       (map vector [:blue :red :green :gray])))

 (defn new-board
   "Create a new board"


Define type FASTAReader

Define type FASTAReader

--- src/clojure/cljam/fasta.clj
+++ src/clojure/cljam/fasta.clj
@@ -2,10 +2,18 @@
   (:refer-clojure :exclude [read slurp])
   (:import java.io.RandomAccessFile))

-(defn reader
-  "Creates a reader on a FASTA file."
-  [^String f]
-  (RandomAccessFile. f "r"))
+;;;
+;;; FASTAReader
+;;;
+
+(deftype FASTAReader [reader f]
+  java.io.Closeable
+  (close [this]
+    (.. this reader close)))
+
+;;;
+;;; Read
+;;;

 (defn- read* [line ^RandomAccessFile rdr]
   (loop [line line
@@ -22,14 +30,24 @@
       (cons (assoc ret :blen (count (filter (partial not= \space) (:seq ret))))
             nil))))

+;;;
+;;; Public
+;;;
+
+(defn reader
+  "Creates a reader on a FASTA file."
+  [f]
+  (->FASTAReader (RandomAccessFile. f "r") f))
+
 (defn read
   "Reads FASTA sequence data, returning its information as a lazy sequence."
-  [^RandomAccessFile rdr]
-  (read* (.readLine rdr) rdr))
+  [^FASTAReader rdr]
+  (let [r (.reader rdr)]
+    (read* (.readLine r) r)))

 (defn slurp
   "Opens a reader on a FASTA file and reads all its contents, returning
   a sequence about the data."
   [f]
-  (with-open [r ^RandomAccessFile (reader f)]
+  (with-open [r (reader f)]
     (doall (read r))))


[NAUGHTY!] Add utilities for using notifications

--- src/clojure/neko/notify.clj
+++ src/clojure/neko/notify.clj
@@ -1,8 +1,11 @@
 (ns neko.notify
   "Provides convenient wrappers for Toast and Notification APIs."
   (:require [neko.application :as app])
-  (:import clojure.lang.Keyword
-           android.content.Context android.widget.Toast))
+  (:import clojure.lang.Keyword android.content.Context
+           android.widget.Toast android.app.Notification
+           android.content.Intent android.app.PendingIntent))
+
+;; ### Toasts

 ;; Stores constants that represent toast's visible timespan.
 ;;
@@ -16,3 +19,71 @@
   ^Toast [message length]
   {:pre [(contains? toast-length length)]}
   (Toast/makeText app/context message (toast-length length)))
+
+;; ### Notifications
+
+(def ^:private default-notification-icon (atom nil))
+
+(defn set-default-notification-icon! [icon]
+  (reset! default-notification-icon icon))
+
+(defn- notification-manager
+  "Returns the notification manager instance."
+  []
+  (.getSystemService app/context Context/NOTIFICATION_SERVICE))
+
+(defn- construct-pending-intent
+  "Creates a PendingIntent instance from a vector where the first
+  element is a keyword representing the action type, and the second
+  element is a action string to create an Intent from."
+  [[action-type action]]
+  (case action-type
+    :activity (PendingIntent/getActivity app/context 0 (Intent. action) 0)
+    :broadcast (PendingIntent/getBroadcast app/context 0 (Intent. action) 0)
+    :service (PendingIntent/getService app/context 0 (Intent. action) 0)))
+
+(defn notification
+  "Creates a Notification instance. If icon is not provided uses the
+  default notification icon."
+  [& {:keys [icon ticker-text when content-title content-text action]
+    :or {icon @default-notification-icon, when (System/currentTimeMillis)}}]
+  (let [notification (Notification. icon ticker-text when)]
+    (.setLatestEventInfo notification app/context content-title content-text
+                         (construct-pending-intent action))
+    notification))
+
+;; This atom stores the mapping of keywords to integer IDs that
+;; represent the notification IDs.
+;;
+(def ^:private notification-ids (atom {}))
+
+;; A simple counter that will increment by one after each call.
+;;
+(def ^:private new-id
+  (let [ctr (atom 0)]
+    (fn []
+      (swap! ctr inc)
+      @ctr)))
+
+(defn fire
+  "Sends the notification to the status bar. ID is optional and could be
+  either an integer or a keyword."
+  ([^Notification notification]
+     (.notify (notification-manager) (new-id) notification))
+  ([id, ^Notification notification]
+     (let [id (if (keyword? id)
+                (if (contains? @notification-ids id)
+                  (@notification-ids id)
+                  (let [number-id (new-id)]
+                    (swap! notification-ids assoc id number-id)
+                    number-id))
+                id)]
+       (.notify (notification-manager) id notification))))
+
+(defn cancel
+  "Removes a notification by the given ID from the status bar."
+  [id]
+  (let [id (if (keyword? id)
+             (@notification-ids id)
+             id)]
+    (.cancel (notification-manager) id)))


Add localstorage stuff

Add localstorage stuff

--- examples/todomvc/src/todomvc/db.cljs
+++ examples/todomvc/src/todomvc/db.cljs
@@ -1,6 +1,7 @@
 (ns todomvc.db
   (:require
     [schema.core :as s :include-macros true]))
+

 ;; -- Schema ------------------------------------------------------------------
 ;;
@@ -16,7 +17,7 @@
 (def schema
   {:todos   (s/both (s/pred map?) (s/pred sorted?))
    :showing (s/enum :all :done :active)
-   :blah (s/enum :all :done :active)   ;; add this bogus schema item in, then watch the console
+   :mistake (s/enum :one :two)   ;; add this bogus schema item in, then watch the console
    })

@@ -24,8 +25,7 @@
   [db]
   (let [res (s/check schema db)]
     (if (some? res)
-      (.error js/console res))
-    db))  ;; so it can be used in middleare
+      (.error js/console (str "schema problem: " res)))))

 ;; -- Default Value  ----------------------------------------------------------
@@ -37,6 +37,20 @@

+;; -- Local Storage  ----------------------------------------------------------
+;;
+;;  Set and Get
+
+(def local-storage-key "re-frame-todomvc")
+
+(defn get-local-storage
+  []
+  (let [data (.getItem js/localStorage local-storage-key)]
+    (when-not (nil? data)
+      (-> data (js/JSON.parse) (js->clj :keywordize-keys true)))))

-
+(defn set-local-storage!
+  [db]
+  (let [data (-> db (clj->js) (js/JSON.stringify))]
+    (.setItem js/localStorage local-storage-key data)))


separate extracting and processing

separate extracting and processing

--- hsm.batch/src/hsm/batch.clj
+++ hsm.batch/src/hsm/batch.clj
@@ -18,37 +18,42 @@
   [s]
   (format "%10s" s))

- (defn mapper [source]
-    (<- [?id ?watchers ?language ?proj]
-      (source :> ?proj ?idx ?watchers ?language ?full)
-      (fill-s :< ?idx :> ?id)
-      (> ?watchers 50)
-      ; (fill-s :< ?languagex :> ?language)
-      ))
+(defn all-projects
+  [source]
+  (<- [?id ?watchers ?language ?proj]
+    (source :> ?proj ?idx ?watchers ?language ?full)
+    (fill-s :< ?idx :> ?id)
+    (> ?watchers 50)
+    ; (fill-s :< ?languagex :> ?language)
+    ))

 (defn top-obj
   [query field cutoff]
   (c/first-n query cutoff :sort field :reverse true))

-(defn exec
-  [f sorting cutoff top-n]
-  (let [objects (b.core/parsevaluate (load-json f))
+(defn top-projects
+  [out-tap query top-n]
+  (?- out-tap
+    (top-obj query ["?watchers"] top-n)))
+
+(defn process
+  [files cutoff top-n]
+  (let [sorting ["?watchers"]]
+    (info files)))
+
+(defn extract
+  [f cutoff]
+  (let [part (last (vec (.split f)))
+        objects (b.core/parsevaluate (load-json f))
         objects (if (> cutoff 0) (subvec (vec objects) 0 cutoff) objects)]
-    (?- (lfs-textline ".run/" :sinkmode :replace)
-      (top-obj
-        (mapper objects)
-         sorting top-n
-        ))))
-
-(defn execute
-  [f cutoff top-n]
-  (exec f ["?watchers"] cutoff top-n)
-  )
-
-
+    (?- (lfs-textline (str ".run/" part "/") :sinkmode :replace)
+       (all-projects objects))))

 (defn -main
   "I don't do a whole lot ... yet."
-  [f cutoff]
-
-  (execute f 0 (Integer/parseInt cutoff)))
+  [mode f cutoff & args]
+  (let [cutoff (Integer/parseInt cutoff)])
+  (condp = mode
+    "e" (extract f cutoff)
+    "g" (process (vec args) 0 cutoff)
+    ))


added jupyter installation comments

added jupyter installation comments

--- main/src/dda/pallet/dda_managed_ide/infra/devops.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/devops.clj
@@ -52,6 +52,9 @@
 ;sudo pip3 install pip --upgrade
 ;pip install pybuilder --user
 ;export PATH=$PATH:~/.local/bin
+;pip install jupyterlab
+;pip install pandas
+;pip install matplottlib

 (defn install-mfa
   [facility]


(PDB-5141) prune-daily-partitions: pull out lock_timeout handling

Move the lock timeout handling to call-with-lock-timeout so that we'll
be able to test it more easily/independently.

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1585,6 +1585,25 @@
   (env-config-for-db-ulong "PDB_GC_DAILY_PARTITION_DROP_LOCK_TIMEOUT_MS"
                            (* 5 60 1000)))

+(defn call-with-lock-timeout [f timeout-ms]
+  (let [set-timeout #(->> (format "set local lock_timeout = %d" %)
+                          (sql/execute! jdbc/*db*))]
+    ;; FIXME: possibly too crude...
+    (let [orig (-> "show lock_timeout"
+                   query-to-vec first :lock_timeout Long/parseLong)]
+      (set-timeout timeout-ms)
+      (let [result (f)]
+        ;; FIXME: For now we assume that when there's an exception,
+        ;; the transaction's about to end, and that'll restore the
+        ;; original value.  We don't use finally because we noticed
+        ;; some trouble there, presumably during an exception that had
+        ;; made restore operation invalid, and we didn't have time to
+        ;; investigate.  Depending on what the issue was, we might be
+        ;; able to put the set-timeout in a murphy finally block
+        ;; (i.e. to chain the two exceptions).
+        (set-timeout orig)
+        result))))
+
 (defn prune-daily-partitions
   "Deletes obsolete day-oriented partitions older than the date.
   Deletes only the oldest such candidate if incremntal? is true.  Will
@@ -1625,24 +1644,10 @@
                     (log/warn (trs "More than 2 partitions to prune: {0}"
                                    (pr-str (butlast candidates))))))
                 (doseq [candidate candidates]
-                  (drop-one candidate)))
-        set-timeout #(->> (format "set local lock_timeout = %d" %)
-                          (sql/execute! jdbc/*db*))]
-    ;; FIXME: possibly too crude...
+                  (drop-one candidate)))]
     (if-not daily-partition-drop-lock-timeout-ms
       (drop)
-      (let [orig (-> "show lock_timeout"
-                     query-to-vec first :lock_timeout Long/parseLong)]
-        (set-timeout daily-partition-drop-lock-timeout-ms)
-        (let [result (drop)]
-          ;; FIXME: For now we assume that when there's an exception,
-          ;; the transaction's about to end, and that'll restore the
-          ;; original value.  We don't use finally because we noticed
-          ;; some trouble there, presumably during an exception that
-          ;; had made restore operation invalid, and we didn't have
-          ;; time to investigate.
-          (set-timeout orig)
-          result)))))
+      (call-with-lock-timeout drop daily-partition-drop-lock-timeout-ms))))

 (defn delete-resource-events-older-than!
   "Delete all resource events in the database by dropping any partition older than the day of the year of the given


bumped up reagent

bumped up reagent

--- resources/leiningen/new/reagent_frontend/project.clj
+++ resources/leiningen/new/reagent_frontend/project.clj
@@ -6,7 +6,7 @@

   :dependencies [[org.clojure/clojure "1.8.0" :scope "provided"]
                  [org.clojure/clojurescript "1.9.36" :scope "provided"]
-                 [reagent "0.6.0-alpha2"]
+                 [reagent "0.6.0-rc"]
                  [reagent-forms "0.5.22"]
                  [reagent-utils "0.1.7"]
                  [secretary "1.2.3"]]


Increment version number to 2.1.1

Increment version number to 2.1.1

--- metrics-clojure-ring/project.clj
+++ metrics-clojure-ring/project.clj
@@ -1,4 +1,4 @@
-(defproject metrics-clojure-ring "2.1.0-SNAPSHOT"
+(defproject metrics-clojure-ring "2.1.1-SNAPSHOT"
   :description "Various things gluing together metrics-clojure and ring."
   :dependencies [[cheshire "5.3.1"]
                  [metrics-clojure "2.0.0"]]


conexp.contrib.draw now exports all relevant namespaces

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

--- src/conexp/contrib/draw.clj
+++ src/conexp/contrib/draw.clj
@@ -7,12 +7,18 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns conexp.contrib.draw
-  (:require conexp.contrib.draw.lattices)
+  (:require conexp.contrib.draw.scenes
+            conexp.contrib.draw.scene-layouts
+            conexp.contrib.draw.nodes-and-connections
+            conexp.contrib.draw.lattices)
   (:use [clojure.contrib.ns-utils :only (immigrate)]))

 ;;;

-(immigrate 'conexp.contrib.draw.lattices)
+(immigrate 'conexp.contrib.draw.scenes
+           'conexp.contrib.draw.scene-layouts
+           'conexp.contrib.draw.nodes-and-connections
+           'conexp.contrib.draw.lattices)

 ;;;


Fixed error in servlet tests

Fixed error in servlet tests

--- ring-servlet/test/ring/util/test/servlet.clj
+++ ring-servlet/test/ring/util/test/servlet.clj
@@ -33,6 +33,7 @@
       (swap! response assoc :status status))
     (setHeader [name value]
       (swap! response assoc-in [:headers name] value))
+    (setCharacterEncoding [value])
     (setContentType [value]
       (swap! response assoc :content-type value))))


Fix message inconsistences on exceptions on compact impl.

--- src/buddy/sign/compact.clj
+++ src/buddy/sign/compact.clj
@@ -134,7 +134,7 @@
         candidate (bytes/concat input salt stamp)]
     (when-not (verify-signature candidate signature key alg)
       (throw (ex-info "Message seems corrupt or manipulated."
-                      {:type :validation :auth :message})))
+                      {:type :validation :cause :signature})))
     (let [now (util/timestamp)
           stamp (codecs/bytes->long stamp)]
       (when (and (number? max-age) (> (- now stamp) max-age))


Small formatting thing

Small formatting thing

--- src/scramblyzer/analyzer.clj
+++ src/scramblyzer/analyzer.clj
@@ -57,8 +57,8 @@
   "Unless the piece or any of its twists matches the predicate,
   replace it with the Acube symbol for ignore (@?)"
   (if (pred piece)
-    piece
-    "@?"))
+      piece
+      "@?"))

 (defn- string->pieces
   [reid-string]


Change either monad to record

Change either monad to record

This allows us to use `clojure.spec` with it :)

```clojure
(s/def :un/right int?)
(s/def :un/left string?)
(s/def :either/spec (s/and either/either?
                           (s/or :right (s/and either/right? (s/keys :req-un [:un/right]))
                                 :left (s/and either/left? (s/keys :req-un [:un/left])))))
```

I'm still not sure how to make it compatible with generators.

--- src/cats/monad/either.cljc
+++ src/cats/monad/either.cljc
@@ -45,95 +45,37 @@

 (declare context)

-(deftype Right [v]
+(defrecord Right [right]
   p/Contextual
   (-get-context [_] context)

   p/Extract
-  (-extract [_] v)
+  (-extract [_] right)

   p/Printable
   (-repr [_]
-    (str "#<Right " (pr-str v) ">"))
-
-  #?@(:cljs [cljs.core/ILookup
-             (-lookup
-               [this k]
-                 (if (= k :right) @this nil))
-             (-lookup
-               [this k not-found]
-                 (if (= k :right) @this not-found))]
-      :clj  [clojure.lang.ILookup
-             (valAt
-               [this k]
-                 (if (= k :right) @this nil))
-             (valAt
-               [this k not-found]
-                 (if (= k :right) @this not-found))])
+    (str "#<Right " (pr-str right) ">"))

   #?@(:cljs [cljs.core/IDeref
-             (-deref [_] v)]
+             (-deref [_] right)]
       :clj  [clojure.lang.IDeref
-             (deref [_] v)])
-
-  #?@(:clj
-      [Object
-       (equals [self other]
-         (if (instance? Right other)
-           (= v (.-v ^Right other))
-           false))]
-
-      :cljs
-      [cljs.core/IEquiv
-       (-equiv [_ other]
-         (if (instance? Right other)
-           (= v (.-v ^Right other))
-           false))]))
-
-(deftype Left [v]
+             (deref [_] right)]))
+
+(defrecord Left [left]
   p/Contextual
   (-get-context [_] context)

   p/Extract
-  (-extract [_] v)
+  (-extract [_] left)

   p/Printable
   (-repr [_]
-    (str "#<Left " (pr-str v) ">"))
-
-  #?@(:cljs [cljs.core/ILookup
-             (-lookup
-               [this k]
-                 (if (= k :left) @this nil))
-             (-lookup
-               [this k not-found]
-                 (if (= k :left) @this not-found))]
-      :clj  [clojure.lang.ILookup
-             (valAt
-               [this k]
-                 (if (= k :left) @this nil))
-             (valAt
-               [this k not-found]
-                 (if (= k :left) @this not-found))])
+    (str "#<Left " (pr-str left) ">"))

   #?@(:cljs [cljs.core/IDeref
-             (-deref [_] v)]
+             (-deref [_] left)]
       :clj  [clojure.lang.IDeref
-             (deref [_] v)])
-
-  #?@(:clj
-      [Object
-       (equals [self other]
-         (if (instance? Left other)
-           (= v (.-v ^Left other))
-           false))]
-
-      :cljs
-      [cljs.core/IEquiv
-       (-equiv [_ other]
-         (if (instance? Left other)
-           (= v (.-v ^Left other))
-           false))]))
+             (deref [_] left)]))

 (alter-meta! #'->Right assoc :private true)
 (alter-meta! #'->Left assoc :private true)
@@ -143,13 +85,13 @@

 (defn left
   "A Left type constructor."
-  ([] (Left. nil))
-  ([v] (Left. v)))
+  ([] (->Left nil))
+  ([v] (->Left v)))

 (defn right
   "A Right type constructor."
-  ([] (Right. nil))
-  ([v] (Right. v)))
+  ([] (->Right nil))
+  ([v] (->Right v)))

 (defn left?
   "Return true if `v` is an instance
@@ -188,14 +130,14 @@
     p/Functor
     (-fmap [_ f s]
       (if (right? s)
-        (right (f (.-v ^Right s)))
+        (right (f (p/-extract ^Right s)))
         s))

     p/Bifunctor
     (-bimap [_ f g s]
       (if (left? s)
-        (left  (f (.-v ^Left s)))
-        (right (g (.-v ^Right s)))))
+        (left  (f (p/-extract ^Left s)))
+        (right (g (p/-extract ^Right s)))))

     p/Applicative
     (-pure [_ v]
@@ -203,7 +145,7 @@

     (-fapply [m af av]
       (if (right? af)
-        (p/-fmap m (.-v ^Right af) av)
+        (p/-fmap m (p/-extract ^Right af) av)
         af))

     p/Monad
@@ -214,7 +156,7 @@
       (assert (either? s) (str "Context mismatch: " (p/-repr s)
                                " is not allowed to use with either context."))
       (if (right? s)
-        (f (.-v ^Right s))
+        (f (p/-extract ^Right s))
         s))

     p/MonadZero


select the first organization by default on the add-projects page

--- frontend/controllers/navigation.cljs
+++ frontend/controllers/navigation.cljs
@@ -185,7 +185,10 @@
   (let [api-ch (get-in current-state [:comms :api])]
     (when-not (seq (get-in current-state state/projects-path))
       (api/get-projects api-ch))
-    (ajax/ajax :get "/api/v1/user/organizations" :organizations api-ch)
+    (go (let [api-result (<! (ajax/managed-ajax :get "/api/v1/user/organizations"))]
+          (put! api-ch [:organizations (:status api-result) api-result])
+          (when-let [first-org (first (:resp api-result))]
+            (put! (get-in current-state [:comms :controls]) [:selected-add-projects-org {:login (:login first-org) :type :org}]))))
     (ajax/ajax :get "/api/v1/user/collaborator-accounts" :collaborators api-ch))
   (set-page-title! "Add projects"))


[scamp] Implement 'handle-forwarded-subscription

--- modules/scamp/src/scamp/core.clj
+++ modules/scamp/src/scamp/core.clj
@@ -263,11 +263,11 @@
    (*get-envelope-id*)])

 (s/defn handle-forwarded-subscription :- CommUpdateSchema
-  "Take a node and a new subscription, and either accept the
-  subscription into :downstream, or forward it to a :downstream
-  node.
-
-  Return a vector matching the CommUpdateSchema."
+  "Take 'logging-config, a node, a new subscription, and an
+  'envelope-id. Either accept the subscription into :downstream, or
+  forward it to a :downstream node.
+
+  Return a vector matching 'CommUpdateSchema."
   [logging-config
    {:keys [downstream] :as node} :- NetworkedNodeSchema
    subscriber-contact-address :- NodeContactAddressSchema
@@ -276,12 +276,14 @@
                :handle-forwarded-subscription
                :node node
                :subscriber-contact-address subscriber-contact-address)
-  (if (and (not (downstream subscriber-contact-address))
-           ;; The subscription id is not already in node's downstream,
+  (if (and (not= (get-in node [:self :id]) subscriber-contact-address)
+           (not (downstream subscriber-contact-address))
+           ;; The subscription id is not for this node itself, and
+           ;; the subscription id is not already in node's downstream,
            ;; so check the probability that we add it to this node.
            (do-probability (subscription-acceptance-probability downstream)))
     [(update-in node [:downstream] conj subscriber-contact-address)
-     [#_(handle-add-upstream id (:id node))]]
+     [(notify-add-upstream node subscriber-contact-address)]]

     (let [forwarded-subscription-messages (forward-subscription downstream
                                                                 subscriber-contact-address


Run cqp commands in child process

Run cqp commands in child process

--- src/clj/cglossa/search.clj
+++ src/clj/cglossa/search.clj
@@ -1,7 +1,63 @@
 (ns cglossa.search
   (:require [cglossa.db :as db]
-            [clojure.string :as str]))
+            [clojure.string :as str]
+            [me.raynes.fs :as fs]
+            [me.raynes.conch :as conch]))
+
+(defn- cwb-corpus-name [corpus queries]
+  (let [uc-code (str/upper-case (:code corpus))]
+    (if (:multilingual? corpus)
+      ;; The CWB corpus we select before running our query will be the one named by the
+      ;; code attribute of the corpus plus the name of the language of the first
+      ;; submitted query row (e.g. RUN_EN).
+      (str uc-code "_" (-> queries first :lang str/upper-case))
+      uc-code)))
+
+(defn- build-monolingual-query [queries]
+  ;; For monolingual queries, the query expressions should be joined together with '|' (i.e., "or")
+  (let [queries* (map :query queries)]
+    (if (> (count queries*) 1)
+      (->> queries*
+           (map #(str "(" % ")"))
+           (str/join " | "))
+      (first queries*))))
+
+(defn- build-multilingual-query [queries]
+  ;; TODO
+  )
+
+(defn- run-cqp-commands [commands]
+  (let [cmdfile   (str (fs/tmpdir) (fs/temp-name "cglossa-cqp-cmd"))
+        commands* (->> commands
+                       (map #(str % \;))
+                       (str/join \newline))]
+    (spit cmdfile commands*)
+    (let [results (-> (conch/with-programs [cqp]
+                                           (cqp "-c" "-f" cmdfile {:seq true}))
+                      ;; Throw away the first line with the CQP version
+                      rest)]
+      (fs/delete cmdfile)
+      results)))

 (defn search [corpus-rid queries]
-  (let [corpus (db/sql-query "select from #TARGET" {:target corpus-rid})]
-    "hei"))+  (let [search         (db/run-sql "create vertex Search")
+        search-id      (db/stringify-rid search)
+        corpus         (first (db/sql-query "select from #TARGET" {:target corpus-rid}))
+        ;; name of saved query in CQP, e.g. MYCORPUS11
+        named-query    (str (str/upper-case (:code corpus))
+                            (last (str/split search-id #":")))
+        query-str      (if (:multilingual? corpus)
+                         (build-multilingual-query queries)
+                         (build-monolingual-query queries))
+        query-commands (if (:metadata-value-ids queries)
+                         ""                                 ; TODO
+                         (str named-query " = " query-str))
+        commands       [(str "set DataDirectory \"" (fs/tmpdir) \")
+                        (cwb-corpus-name corpus queries)
+                        query-commands
+                        (str "save " named-query)
+                        "size Last"]
+        num-hits       (run-cqp-commands commands)]
+    (-> search
+        db/vertex->map
+        (assoc :num-hits num-hits))))


Trivial move of defrecord

Trivial move of defrecord

--- src/clj/ji/domain/game.clj
+++ src/clj/ji/domain/game.clj
@@ -11,6 +11,8 @@
                :color colors
                :number numbers
                :fill fills})
+
+(defrecord Game [deck board players])

 (defn new-deck []
   (for [s shapes c colors n numbers f fills]
@@ -44,8 +46,6 @@
          (map solve-pair)
          (keep identity)
          (distinct))))
-
-(defrecord Game [deck board players])

 (defn new-game []
   (map->Game {:deck (-> (new-deck) (shuffle))


autoredeploy -> catch also client ex

autoredeploy -> catch also client ex

--- src/clj/swarmpit/agent.clj
+++ src/clj/swarmpit/agent.clj
@@ -13,15 +13,15 @@
     (doseq [service services]
       (let [id (:id service)
             repository (:repository service)
-            current-image-id (:imageId repository)
-            latest-image-id (api/service-image-id service true)]
-        (when (not= current-image-id
-                    latest-image-id)
-          (try
-            (api/update-service id service true)
-            (log/info "Service" id "has been redeployed! [" current-image-id "] -> [" latest-image-id "]")
-            (catch ExceptionInfo e
-              (log/error "Service" id "autoredeploy failed! " (ex-data e)))))))))
+            current-image-id (:imageId repository)]
+        (try
+          (let [latest-image-id (api/service-image-id service true)]
+            (when (not= current-image-id
+                        latest-image-id)
+              (api/update-service id service true)
+              (log/info "Service" id "has been redeployed! [" current-image-id "] -> [" latest-image-id "]")))
+          (catch ExceptionInfo e
+            (log/error "Service" id "autoredeploy failed! " (ex-data e))))))))

 (defn init
   []


Comments about next step

Comments about next step

--- src/cljs/frereth/core.cljs
+++ src/cljs/frereth/core.cljs
@@ -1,5 +1,7 @@
 (ns ^:figwheel-always frereth.core
-    "TODO: Do something interesting here"
+    "This part should trigger the system start, and not much more
+
+Right now, that isn't the case at all."
     (:require-macros [cljs.core.async.macros :as asyncm :refer (go go-loop)]
                      [schema.macros :as macros]
                      [schema.core])


Removing unused namespaces from core.cljs

All function using them are now on other namespaces, like the handlers.

--- src/cljs/memento/core.cljs
+++ src/cljs/memento/core.cljs
@@ -3,17 +3,11 @@
             [bidi.bidi :as bidi]
             [clojure.string :refer [trim split]]
             [cljsjs.react-bootstrap]
-            [cljs-time.format :as tf]
-            [cljs-time.coerce :as tc]
             [reagent.cookies :as cookies]
             [reagent.core :as reagent :refer [atom]]
             [re-frame.core :refer [dispatch reg-sub reg-event-db subscribe dispatch-sync]]
             [jayq.core :refer [$]]
             [markdown.core :refer [md->html]]
-            [markdown.common :as mdcommon]
-            [markdown.links :as mdlinks]
-            [markdown.lists :as mdlists]
-            [markdown.transformers :as transformers]
             [memento.handlers.auth :refer [clear-token-on-unauth]]
             [memento.handlers.cache]
             [memento.handlers.memory]
@@ -24,7 +18,6 @@
             [memento.helpers :as helpers]
             [pushy.core :as pushy]
             [ajax.core :refer [GET POST PUT DELETE]]
-            [clojure.string :as string]
             [taoensso.timbre :as timbre
              :refer-macros [log trace debug info warn error fatal report
                             logf tracef debugf infof warnf errorf fatalf reportf


Rename error to errors

Rename error to errors

--- src/cljs/re_form/core.cljs
+++ src/cljs/re_form/core.cljs
@@ -234,7 +234,7 @@
 (defn field [props]
   [ctx/get-context props binded-field])

-(defn- error* [{:keys [form-name path error-paths] :as props}]
+(defn- errors* [{:keys [form-name path error-paths] :as props}]
   (let [flags @(rf/subscribe [:re-form/input-flags form-name path])
         is-form-submitting @(rf/subscribe [:re-form/is-form-submitting form-name])
         errors @(rf/subscribe [:re-form/input-errors form-name (into [path] error-paths)])]
@@ -243,8 +243,8 @@
             {:errors (if (or (:touched flags) is-form-submitting)
                        errors [])})]))

-(defn error [props]
-  [ctx/get-context props error*])
+(defn errors [props]
+  [ctx/get-context props errors*])

 (defn input [& args]
   (.error js/console "Warning! `re-form.input` is deprecated. Please use `re-form.field` instead. Caused by " (into ["re-form.input"] args))


fix tagged literal map parsing

fix tagged literal map parsing

--- src/cljs_api_gen/parse.clj
+++ src/cljs_api_gen/parse.clj
@@ -722,9 +722,13 @@
   [form]
   (when (and (list? form)
              (= (take 2 form) '(def *cljs-data-readers*)))
-    (->> (nth form 2)
-         (map (fn [[k v]] [(second k) v])) ;; (quote x) -> x for keys
-         (into {}))))
+    (let [tag-map (cond
+                    (cljs-cmp <= "1.9.293") (nth form 2)
+                    :else (let [[_merge _custom tag-map] (nth form 2)]
+                            tag-map))]
+      (->> tag-map
+           (map (fn [[k v]] [(second k) v])) ;; (quote x) -> x for keys
+           (into {})))))

 (defn parse-tagged-literals
   []


Fix json search

Fix json search

--- src/clojars/web/search.clj
+++ src/clojars/web/search.clj
@@ -31,9 +31,7 @@
        (let [results (search/search query)]
          (if (empty? results)
            [:p "No results."]
-           (for [jar results
-                 ;; bc too lazy to see why blank entries are showing up
-                 :when (not (nil? (:artifact-id jar)))]
+           (for [jar results]
              [:li.search-results
               (jar-link {:jar_name (:artifact-id jar)
                          :group_name (:group-id jar)}) " " (:version jar)


remove an unsed function.

remove an unsed function.

--- src/tamaki/template/page.clj
+++ src/tamaki/template/page.clj
@@ -29,8 +29,6 @@
          body (.toString output)]
      (merge {:body body :src md} {:metadata (merge metadata {:title (-> metadata :title first)
                                                              :template (-> metadata :template first)})}))))
-
-

 (defn- read-page [md]
   "Deprecated. Use render-page."
@@ -126,10 +124,3 @@
           (tfile/create-empty-file output)
           (require (symbol (str/replace template  #"/.*"  "")))
           (spit output ((var-get (resolve (symbol template))) post))))))
-
-
-(defn- create-neighbor-url [urls]
-  "REFACTORING create current-page"
-  (map (fn [p n] {:previous-page p :next-page n})
-       (cons nil (drop-last urls))
-       (concat (rest urls) '(nil))))


whitespace

whitespace

--- server/src/gratefulplace/db/transactions.clj
+++ server/src/gratefulplace/db/transactions.clj
@@ -5,45 +5,6 @@
             [gratefulplace.db.mapification :refer [mapify-tx-result]]
             [flyingmachine.cartographer.core :as c]
             [gratefulplace.utils :refer :all]))
-
-(defn create-topic
-  [params]
-  (let [topic-tempid (d/tempid :db.part/user -1)
-        post-tempid (d/tempid :db.part/user -2)
-        watch-tempid (d/tempid :db.part/user -3)
-        author-id (:author-id params)
-        topic (remove-nils-from-map {:topic/title (:title params)
-                                     :topic/first-post post-tempid
-                                     :topic/last-posted-to-at (now)
-                                     :content/author author-id
-                                     :content/deleted false
-                                     :db/id topic-tempid})
-        watch {:db/id watch-tempid
-               :watch/unread-count 0
-               :watch/topic topic-tempid
-               :watch/user author-id}
-        post {:post/content (:content params)
-              :post/topic topic-tempid
-              :post/created-at (now)
-              :content/author author-id
-              :db/id post-tempid}
-        result (db/t [topic post watch])]
-
-    ;; TODO find a better home for this
-    ;; get topic reuslt here and actualize it
-    (comment
-      (future
-        (let [topic (c/mapify (db/ent topic-id) mr/ent->topic {:except [:last-posted-to-at]})]
-          (doseq [watch watches]
-            (let [user (c/mapify (:watch/user watch) mr/ent->user)]
-              (if (and
-                   (get-in user [:preferences "receive-watch-notifications"])
-                   (not= author-id (:id user)))
-                ;; TODO actually handle this
-                ))))))
-
-    {:result result
-     :tempid topic-tempid}))

 (defn create-watch
   [params]
@@ -61,7 +22,3 @@
     {:result (db/t [params])
      :tempid (:db/id params)}))

-(defn reset-watch-count
-  [topic user]
-  (let [watch (db/one [:watch/topic topic] [:watch/user user])]
-    (db/t [{:db/id (:db/id watch) :watch/unread-count 0}])))


Fix error with key

Fix error with key

--- src/cyanite_cache/cache.clj
+++ src/cyanite_cache/cache.clj
@@ -110,11 +110,12 @@
     (reify
       StoreCache
       (put! [this tenant period rollup time path data ttl]
-        (set-keys! mkeys tenant period rollup time path ttl (get-get-fn! rollup)
-                   fn-agg fn-store)
-        (swap! (get-cache! rollup)
-               (fn [cache]
-                 (assoc cache key (conj (get cache key) data)))))
+        (let [ckey (construct-key tenant period rollup time path)]
+          (set-keys! mkeys tenant period rollup time path ttl
+                     (get-get-fn! rollup) fn-agg fn-store)
+          (swap! (get-cache! rollup)
+                 (fn [cache]
+                   (assoc cache ckey (conj (get cache ckey) data))))))
       (flush! [this])
       (-show-keys [this] (println mkeys))
       (-show-cache [this] (println caches)))))


Remove future.

Remove future.

--- src/defragment/hubzilla.clj
+++ src/defragment/hubzilla.clj
@@ -23,13 +23,12 @@

 (defn post-all
   [settings items]
-  (future
-    (doseq [item items]
-      (when-not (-> item :title empty?)
+  (doseq [item items]
+    (when-not (-> item :title empty?)
       (try
         (post-to-hubzilla settings item)
         (catch Exception e
-          (log/error e)))))))
+          (log/error e))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Add a compound primary key to avoid duplicate mappings

--- src/doctopus/db/schema.clj
+++ src/doctopus/db/schema.clj
@@ -48,7 +48,8 @@

 (def head-tentacle-schema
   [[:head_name "varchar(50) references heads(name) on delete cascade"]
-   [:tentacle_name "varchar(50) references tentacles(name) on delete cascade"]])
+   [:tentacle_name "varchar(50) references tentacles(name) on delete cascade"]
+   ["PRIMARY KEY(head_name, tentacle_name)"]])

 (defn do-sql-with-logging!
   [sql-statement db-name]


Add JDK 16 to build matrix

Add JDK 16 to build matrix

--- src/docker_clojure/core.clj
+++ src/docker_clojure/core.clj
@@ -33,7 +33,7 @@

 (def base-image "openjdk")

-(def jdk-versions #{8 11 14 15})
+(def jdk-versions #{8 11 14 15 16})

 ;; The default JDK version to use for tags that don't specify one; usually the latest LTS release
 (def default-jdk-version 11)
@@ -115,9 +115,14 @@
         (assoc :docker-tag (docker-tag base))
         (assoc-if #(nil? (:build-tool-version base)) :build-tool-versions build-tools))))

-(defn build-image [{:keys [docker-tag dockerfile build-dir] :as variant}]
+(defn pull-image [image]
+  (sh "docker" "pull" image))
+
+(defn build-image [{:keys [docker-tag dockerfile build-dir base-image] :as variant}]
   (let [image-tag (str "clojure:" docker-tag)
         build-cmd ["docker" "build" "-t" image-tag "-f" dockerfile "."]]
+    (println "Pulling base image" base-image)
+    (pull-image base-image)
     (df/write-file build-dir dockerfile variant)
     (apply println "Running" build-cmd)
     (let [{:keys [out err exit]}


got album art size right

got album art size right

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -104,8 +104,12 @@
               tags (.-tags music-info)]

           (dom/div nil
-            (dom/img #js {:src (:cover-image state) ;grey-out-image
-                          :style #js {:float "left"}})
+            (dom/div #js {:style #js {:float "left"
+                                      :width "10%"
+                                      :height "10%"}}
+              (dom/img #js {:src (:cover-image state)
+                            :style #js {:width "100%"
+                                        :height "100%"}}))
             (dom/div nil
               (dom/div nil (.-title tags))
               (dom/div nil (.-album tags))


Increase thread count test timeout to 30 seconds

--- ring-jetty-adapter/test/ring/adapter/test/jetty.clj
+++ ring-jetty-adapter/test/ring/adapter/test/jetty.clj
@@ -151,7 +151,7 @@
       (let [thread-count (count (all-threads))]
         (is (thrown? Exception (run-jetty hello-world {:port 4347})))
         (loop [i 0]
-          (when (and (< i 100) (not= thread-count (count (all-threads))))
+          (when (and (< i 300) (not= thread-count (count (all-threads))))
             (Thread/sleep 100)
             (recur (inc i))))
         (is (= thread-count (count (all-threads))))))))


fix dependency

fix dependency

--- resources/leiningen/new/ow_app/project.clj
+++ resources/leiningen/new/ow_app/project.clj
@@ -17,7 +17,7 @@
                  [re-frame     "0.9.1"]           ;; browser program flow

                  ;;; http:
-                 [ring-core              "1.4.0"]  ;; basic middlewares
+                 [ring/ring-core         "1.4.0"]  ;; basic middlewares
                  [http-kit               "2.2.0"]  ;; http server
                  [ring/ring-defaults     "0.2.1"]  ;; common middlewares
                  [bk/ring-gzip           "0.1.1"]


Disable logging to datomic

Disable logging to datomic

--- src/yetibot/core/logging.clj
+++ src/yetibot/core/logging.clj
@@ -26,11 +26,12 @@

 (defn start []
   ; log to datomic
-  (timbre/set-config!
-    [:appenders :datomic]
-    {:doc       "Datomic logger"
-     :min-level :info
-     :enabled?  true
-     :async?    false
-     :limit-per-msecs nil ; No rate limit
-     :fn #'log-to-db}))
+  #_(timbre/set-config!
+      [:appenders :datomic]
+      {:doc       "Datomic logger"
+       :min-level :info
+       :enabled?  true
+       :async?    false
+       :limit-per-msecs nil ; No rate limit
+       :fn #'log-to-db})
+  )


fix `post-select` behavior when you pass a vector like `[User :id]` to `sel`

--- src/metabase/db.clj
+++ src/metabase/db.clj
@@ -90,7 +90,8 @@
     (sel :many Table :db_id 1 (order :name :ASC)) -> (select User (where {:id 1}) (order :name ASC))"
   [one-or-many entity & forms]
   `(->> (-sel-select ~entity ~@forms)
-        (map (partial post-select ~entity))
+        (map (partial post-select ~(if (vector? entity) (first entity)
+                                       entity)))
         ~(case one-or-many
            :one 'first
            :many 'identity)))


Clean up saving-media ns.

Clean up saving-media ns.

--- src/clojure/com/dankee/camera_spike/saving_media.clj
+++ src/clojure/com/dankee/camera_spike/saving_media.clj
@@ -1,32 +1,42 @@
-(ns com.dankee.camera_spike.saving-media)
+(ns com.dankee.camera_spike.saving-media
+  (:import [android.net Uri]
+           [android.os Environment]
+           [android.util Log]
+           [java.io File]
+           [java.text SimpleDateFormat]
+           [java.util Date] ) )

 ; Port of https://developer.android.com/guide/topics/media/camera.html#saving-media

 (def media-type-image 1)
 (def media-type-video 2)

-(defn create-media-file [type media-storage-dir]
-  (let [timestamp (.. (new java.text.SimpleDateFormat "yyyyMMdd_HHmmss")
-                      (format (new java.util.Date)) )]
+(defn- create-media-file [type media-storage-dir]
+  (let [timestamp (.format (new SimpleDateFormat "yyyyMMdd_HHmmss") (new Date))]
     (case type
-      media-type-image (new java.io.File (str (.getPath media-storage-dir)
-                                              java.io.File/separator
+      media-type-image (new File (str (.getPath media-storage-dir)
+                                              File/separator
                                               "IMG_" timestamp ".jpg"))
-      media-type-video (new java.io.File (str (.getPath media-storage-dir)
-                                              java.io.File/separator
+      media-type-video (new File (str (.getPath media-storage-dir)
+                                              File/separator
                                               "VID_" timestamp ".mp4"))
       nil ) ) )

-(defn get-output-media-file [type]
-  (let [media-storage-dir (new java.io.File
-                               (android.os.Environment/getExternalStoragePublicDirectory
-                                android.os.Environment/DIRECTORY_PICTURES )
+(defn- get-output-media-file [type]
+  (let [media-storage-dir (new File
+                               (Environment/getExternalStoragePublicDirectory Environment/DIRECTORY_PICTURES)
                                "Camera Spike" )]
     (if (and (not (.exists media-storage-dir))
              (not (.mkdirs media-storage-dir)) )
-      (android.util.Log/d "Camera Spike" "failed to create directory")
+      (Log/d "Camera Spike" "failed to create directory")
       (create-media-file type media-storage-dir) ) ) )

-(defn get-output-media-file-uri [type]
-  (android.net.Uri/fromFile (get-output-media-file type)) )
+(defn- get-output-media-file-uri [type]
+  (Uri/fromFile (get-output-media-file type)) )

+(defn get-output-image-uri []
+  (get-output-media-file-uri media-type-image) )
+
+(defn get-output-video-uri []
+  (get-output-media-file-uri media-type-video) )
+


Fixed small typo in dialog page.

Fixed small typo in dialog page.

--- src/cljs/reagent_toolbox_docs/components/dialog.cljs
+++ src/cljs/reagent_toolbox_docs/components/dialog.cljs
@@ -49,7 +49,7 @@
          [:td [:code "false"]]
          [:td "If true, the dialog will be active."]]
         [:tr
-         [:td [:code "className"]]
+         [:td [:code "class-name"]]
          [:td [:code "string"]]
          [:td [:code "\"\""]]
          [:td "Sets a class to give customized styles to the dialog."]]


accidentally a parameter

accidentally a parameter

--- src/riffle/read.clj
+++ src/riffle/read.clj
@@ -23,7 +23,7 @@
 (defn riffle
   "Returns a Riffle object that can be used with `get` and `entries`."
   ([path]
-     (riffle 1))
+     (riffle path 1))
   ([path num-file-descriptors]
      (r/riffle path num-file-descriptors)))


Clear form state after closing modal

Clear form state after closing modal

Previously, the form field contents would remain after closing and
reopening the modal. Not closing the modal unmounts the component, which
clears the state.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1736,7 +1736,7 @@
          [:div.sub-info "Apple Code Signing requires a valid Code Signing Identity (p12) file"]]))))

-(defn p12-upload-modal [{:keys [show-modal? close-fn error-message project-name vcs-type]} owner]
+(defn p12-upload-modal [{:keys [close-fn error-message project-name vcs-type]} owner]
   (reify
     om/IInitState
     (init-state [_]
@@ -1747,42 +1747,41 @@

     om/IRenderState
     (render-state [_ {:keys [description password file-name file-content]}]
-      (when show-modal?
-        (modal/modal-dialog
-         {:title "Upload a New Apple Code Signing Key"
-          :body
-          (html
-           [:div
-            (om/build common/flashes error-message)
-            [:div
-             (om/build form/text-field {:label "Description"
-                                        :value description
-                                        :on-change #(om/set-state! owner :description (.. % -target -value))})
-             (om/build form/text-field {:label "Password (Optional)"
-                                        :password? true
-                                        :value password
-                                        :on-change #(om/set-state! owner :password (.. % -target -value))})
-             (om/build form/file-selector {:label "Key File"
-                                           :file-name file-name
-                                           :on-change (fn [{:keys [file-name file-content]}]
-                                                        (om/update-state! owner #(merge % {:file-name file-name
-                                                                                :file-content file-content})))})]])
-          :actions [(forms/managed-button
-                     [:input.upload-p12-button
-                      {:data-failed-text "Failed" ,
-                       :data-success-text "Uploaded" ,
-                       :data-loading-text "Uploading..." ,
-                       :value "Upload" ,
-                       :type "submit"
-                       :disabled (not (and file-content description))
-                       :on-click #(raise! owner [:upload-p12 {:project-name project-name
-                                                              :vcs-type vcs-type
-                                                              :description description
-                                                              :password (or password "")
-                                                              :file-content (base64/encodeString file-content)
-                                                              :file-name file-name
-                                                              :on-success close-fn}])}])]
-          :close-fn close-fn})))))
+      (modal/modal-dialog
+       {:title "Upload a New Apple Code Signing Key"
+        :body
+        (html
+         [:div
+          (om/build common/flashes error-message)
+          [:div
+           (om/build form/text-field {:label "Description"
+                                      :value description
+                                      :on-change #(om/set-state! owner :description (.. % -target -value))})
+           (om/build form/text-field {:label "Password (Optional)"
+                                      :password? true
+                                      :value password
+                                      :on-change #(om/set-state! owner :password (.. % -target -value))})
+           (om/build form/file-selector {:label "Key File"
+                                         :file-name file-name
+                                         :on-change (fn [{:keys [file-name file-content]}]
+                                                      (om/update-state! owner #(merge % {:file-name file-name
+                                                                                :file-content file-content})))})]])
+        :actions [(forms/managed-button
+                   [:input.upload-p12-button
+                    {:data-failed-text "Failed" ,
+                     :data-success-text "Uploaded" ,
+                     :data-loading-text "Uploading..." ,
+                     :value "Upload" ,
+                     :type "submit"
+                     :disabled (not (and file-content description))
+                     :on-click #(raise! owner [:upload-p12 {:project-name project-name
+                                                            :vcs-type vcs-type
+                                                            :description description
+                                                            :password (or password "")
+                                                            :file-content (base64/encodeString file-content)
+                                                            :file-name file-name
+                                                            :on-success close-fn}])}])]
+        :close-fn close-fn}))))

 (defn code-signing [{:keys [project-data error-message]} owner]
   (reify
@@ -1814,11 +1813,11 @@
                                                                       :vcs-type vcs-type})))})
              (om/build no-keys-empty-state {:project-name project-name
                                             :add-key #(om/set-state! owner :show-modal? true)}))
-           (om/build p12-upload-modal {:show-modal? show-modal?
-                                       :close-fn #(om/set-state! owner :show-modal? false)
-                                       :error-message error-message
-                                       :project-name project-name
-                                       :vcs-type vcs-type})]])))))
+           (when show-modal?
+             (om/build p12-upload-modal {:close-fn #(om/set-state! owner :show-modal? false)
+                                         :error-message error-message
+                                         :project-name project-name
+                                         :vcs-type vcs-type}))]])))))

 (defn project-settings [data owner]
   (reify


compscriber service

compscriber service

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -217,7 +217,7 @@
     ch."))

 (defn- compscribe*
-  [outer-target subs-fn unsubs-fn
+  [outer-target source-service compscribe-service
    [endpoint direct-hooks deep-hooks :as conformed-spec] id]
   (let [;; Once intercepted, events need to go through target-mix so
         ;; that mix-ins and mix-outs have synchronous effects
@@ -228,22 +228,22 @@
                  (let [ks' (cond-> ks
                              many? (conj id))
                        xch (chan 1 (delta/nest ks'))]
-                   (vswap! subs assoc ks'
-                           [xch (compscribe* xch
-                                             subs-fn
-                                             unsubs-fn
-                                             (get direct-hooks ks)
-                                             id)])
+                   (subscribe compscribe-service
+                              [(get direct-hooks ks) id]
+                              xch)
+                   (vswap! subs assoc ks' xch)
                    ;; xch will be closed by the subscribed-composition
                    (mix-in target-mix xch)))
-        ch-in (subs-fn endpoint id)]
+        ch-in (chan)]
+    (subscribe source-service [endpoint id] ch-in)
     (go-loop []
       (if-some [delta (<! ch-in)]
         (let [[{:keys [subs-one subs-many unsubs]} delta]
               (extract-hooks conformed-spec delta)

               subs-by-pks (group-by-pks @subs)]
-          (doseq [[ks [xch unsubs-fn]]
+          #_(println delta conformed-spec [subs-one subs-many unsubs])
+          (doseq [[ks xch]
                   (->> unsubs
                        (mapcat (fn [ks]
                                  (concat (->> (get subs-by-pks ks)
@@ -251,7 +251,7 @@
                                          (some-> (find @subs ks)
                                                  (vector)))))
                        distinct)]
-            (unsubs-fn)
+            (cancel compscribe-service xch)
             (mix-out target-mix xch)
             (vswap! subs dissoc ks))

@@ -269,9 +269,10 @@
           (recur))
         (do
           (close! target) ;; implicit mix-out
-          (doseq [[_ unsubs-fn] (vals @subs)]
-            (unsubs-fn)))))
-    (fn [] (unsubs-fn ch-in))))
+          (doseq [xch (vals @subs)]
+            (cancel compscribe-service xch)))))
+    (fn [] (cancel source-service ch-in))))
+
 (defn- swap-out!
   "Atomically dissocs k in atom, returns k"
   [atom k]
@@ -302,6 +303,57 @@
   (doto (chan)
     (on-close-pipe target on-close)))

+(defrecord CompscribeService [cached-service source-service subscriptions]
+  IStream
+  (subscribe [this identifier target]
+    (let [[spec id] identifier
+          [endpoint direct-hooks deep-hooks :as spec] (compile-spec spec)
+          subs-target (wrap-on-close target #(cancel this target))]
+      (if (and (empty? direct-hooks)
+               (empty? deep-hooks))
+        ;; OPT: If there is nothing to compscribe, directly reach
+        ;; through to the source-service:
+        (do
+          #_(println "subscribing directly" identifier)
+          (subscribe source-service [endpoint id] subs-target)
+          (swap! subscriptions assoc target
+                 (vary-meta #(cancel source-service subs-target)
+                            assoc ::identifier identifier)))
+        (do
+          #_(println "subscribing" identifier)
+          (swap! subscriptions assoc target
+                 (vary-meta (compscribe* subs-target
+                                         source-service
+                                         cached-service
+                                         spec
+                                         id)
+                            assoc ::identifier identifier))))))
+  (cancel [this target]
+    (when-let [unsubs-fn (swap-out! subscriptions target)]
+      #_(println "unsubscribing" (::identifier (meta unsubs-fn)))
+      (unsubs-fn))))
+
+(defn compscriber
+  [service]
+  (let [service (map->CompscribeService {:source-service service
+                                         :subscriptions (atom {})})
+        service (reify
+                  IStream
+                  (subscribe [this identifier target]
+                    (-> service
+                        (assoc :cached-service this)
+                        (subscribe identifier target)))
+                  (cancel [this target]
+                    (cancel service target)))
+        compile-spec (memoize compile-spec)]
+    (reify
+      IStream
+      (subscribe [_ identifier target]
+        (subscribe service
+                   (update identifier 0 compile-spec)
+                   target))
+      (cancel [_ target]
+        (cancel service target)))))

 (defn compscribe
   "Asynchronously subscribes via subs-fn and unsubs-fn at one or more
@@ -330,8 +382,8 @@
   as ids and are transformed to assert a map {(id streamed-val)+} at
   key.

-  Subscriptions are made at service, an implementation of
-  ISubscriptionService, with [endpoint id] as identifier argument.
+  Subscriptions are made at service, which has to implement IStream,
+  with [endpoint id] as identifier argument.

   id is used to make an initial subscription at the root endpoint.

@@ -339,13 +391,19 @@
   and close target-ch."
   {:arglists '([target-ch service spec id])}
   ([target-ch service spec id]
+   (let [service (compscriber service)]
+     (subscribe service [spec id] target-ch)))
+  ([target-ch subs-fn unsubs-fn spec id]
    (compscribe target-ch
-               (fn [endpoint id]
-                 (subscribe service [endpoint id]))
-               (fn [ch]
-                 (cancel service ch))))
-  ([target-ch subs-fn unsubs-fn spec id]
-   (let [conformed-spec (conform-spec spec)] ;; could allow compiled
-                                             ;; spec by checking for
-                                             ;; ::spec metadata
-     (compscribe* target-ch subs-fn unsubs-fn conformed-spec id))))
+               (let [chs (atom {})]
+                 (reify
+                   IStream
+                   (subscribe [this [endpoint id] target]
+                     (let [ch-in (subs-fn endpoint id)]
+                       (swap! chs assoc target ch-in)
+                       (on-close-pipe ch-in target
+                                      #(cancel this target))))
+                   (cancel [_ ch]
+                     (some-> (swap-out! chs ch)
+                             (unsubs-fn)))))
+               spec id)))


Location plugin, schema cljs require fix

--- src/cljc/salava/location/schemas.cljc
+++ src/cljc/salava/location/schemas.cljc
@@ -1,10 +1,11 @@
 (ns salava.location.schemas
-  (:require [schema.core :as s
-             :include-macros true ;; cljs only
-             ]
-             [schema.coerce :as c]
-             [compojure.api.sweet :refer [describe]]
-            ))
+  #?(:clj (:require [schema.core :as s]
+                    [schema.coerce :as c]
+                    [compojure.api.sweet :refer [describe]])
+     :cljs (:require [schema.core :as s :include-macros true]
+                     [schema.coerce :as c])))
+
+#?(:cljs (defn describe [v _] v))

 (defn between [min max]
   (fn [n]


small fix

small fix

--- src/cljs/salava/badge/ui/pending.cljs
+++ src/cljs/salava/badge/ui/pending.cljs
@@ -88,7 +88,7 @@
                                                                                "private" (t :badge/Private)
                                                                                "internal" (t :badge/Shared)
                                                                                (t :badge/Public)) [:i.fa.fa-chevron-down]]
-      [info "Set your badge visibility" "left"]
+      [info "Set your badge visibility" "bottom"]
        [:ul.dropdown-menu
         [:li [:a {:href "#" :on-click #(do
                                          (.preventDefault %)


Minor ui fix

Minor ui fix

--- src/cljs/salava/badge/ui/receive.cljs
+++ src/cljs/salava/badge/ui/receive.cljs
@@ -69,15 +69,16 @@
   (let [pdf-atom (cursor state [:pdf-atom])]
     (when-let [cert-uri (some-> @state :cert :uri)]
       [:div.pdf-list
-       [:p [:i.fa.fa-file-pdf-o.fa-lg] " " [:a {:href "#" :on-click #(toggle-pdf state)} [:span [:b {:style {:font-size "12px"}} (t :badge/Downloadpdf)] [:i.fa.fa-fw {:class (if @pdf-atom " fa-caret-down" " fa-caret-right")}]]]]
-       (when @pdf-atom
-         (doall
-          (map (fn [[badge lang]]
-                 (let [uri (str cert-uri "&lang=" lang)]
-                   [:p {:key uri :style {:padding "0 1px"}}
-                    [:i.fa.fa-file-pdf-o.fa-fw] " "
-                    [:a {:href uri :style {:font-size "12px"}} (if-not (blank? lang) (str badge " (" lang ")") badge)]]))
-               (:badge @state))))])))
+       #_[:p [:i.fa.fa-file-pdf-o.fa-lg] " " [:a {:href "#" :on-click #(toggle-pdf state)} [:span [:b {:style {:font-size "12px"}} (t :badge/Downloadpdf)] [:i.fa.fa-fw {:class (if @pdf-atom " fa-caret-down" " fa-caret-right")}]]]]
+       [:p [:i.fa.fa-file-pdf-o.fa-lg] " " [:b {:style {:font-size "12px"}} (t :badge/Downloadpdf)]]
+       ;(when @pdf-atom
+       (doall
+        (map (fn [[badge lang]]
+               (let [uri (str cert-uri "&lang=" lang)]
+                 [:p {:key uri :style {:padding "0 1px"}}
+                  [:i.fa.fa-file-pdf-o.fa-fw] " "
+                  [:a {:href uri :style {:font-size "12px"}} (if-not (blank? lang) (str badge " (" lang ")") badge)]]))
+             (:badge @state)))])))

 (defn init-data [state id]
   (ajax/GET


Expose other JRuby embed bootstrap options

--- src/clj/rb.clj
+++ src/clj/rb.clj
@@ -9,6 +9,7 @@
             RubyString
             RubySymbol]
            [org.jruby.embed
+            LocalContextScope
             LocalVariableBehavior
             ScriptingContainer]
            org.jruby.runtime.builtin.IRubyObject
@@ -159,12 +160,22 @@
   * :preserve-locals? - any locals defined in an eval will persist, visible to future evals [false]
   * :load-paths - a sequence of paths to add to the runtime's load path [nil]
   * :env - a map of values to set in the ruby ENV [nil]
-  * :gem-paths - a sequence of paths to search for gems [nil]"
+  * :gem-paths - a sequence of paths to search for gems [nil]
+  * :context-scope - which JRuby embed context to use [:concurrent]
+  * :lazy? - whether to defer to runtime [true]"
   ([] (runtime nil))
-  ([{:keys [preserve-locals? gem-paths load-paths env]}]
-   (let [rt (ScriptingContainer. (if preserve-locals?
-                                   LocalVariableBehavior/PERSISTENT
-                                   LocalVariableBehavior/TRANSIENT))]
+  ([{:keys [preserve-locals? gem-paths load-paths env context-scope lazy?]
+     :or {lazy? true, context-scope :single-thread}}]
+   (let [rt (ScriptingContainer.
+             (case context-scope
+               :single-thread LocalContextScope/SINGLETHREAD
+               :threadsafe LocalContextScope/THREADSAFE
+               :singleton LocalContextScope/SINGLETON
+               :concurrent LocalContextScope/CONCURRENT)
+             (if preserve-locals?
+               LocalVariableBehavior/PERSISTENT
+               LocalVariableBehavior/TRANSIENT)
+             (boolean lazy?))]
      (.setLoadPaths rt (or load-paths []))
      (when-let [paths (seq gem-paths)]
        (setenv rt "GEM_PATH" (str/join ":" (map pr-str paths))))


fix for hashtag replacement when there were two with the same stem

--- iwaswhere-web/src/cljs/iwaswhere_web/markdown.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/markdown.cljs
@@ -9,7 +9,7 @@
   [show-hashtags?]
   (fn [acc hashtag]
     (let [f-hashtag (if show-hashtags? hashtag (subs hashtag 1))]
-      (s/replace acc hashtag (str "**" f-hashtag "**")))))
+      (s/replace acc (re-pattern (str "[^*]" hashtag "(?!\\w)")) (str " **" f-hashtag "**")))))

 (defn mentions-replacer
   "Replaces mentions in entry text."


add missing mappings

add missing mappings

--- src/hu/ssh/github_changelog/formatters/markdown.clj
+++ src/hu/ssh/github_changelog/formatters/markdown.clj
@@ -8,9 +8,14 @@
     [schema.core :as s]))

 (def type-name-map
-  {:fix "Bug Fixes"
+  {:feat "Features"
+   :fix "Bug Fixes"
+   :perf "Performance Improvements"
+   :docs "Documentations"
    :chore "Chores"
-   :feat "Features"})
+   :style "Style Changes"
+   :refactor "Refactorings"
+   :test "Tests"})

 (s/defn translate-type :- s/Str
   [type :- s/Str]


translate changeset types

translate changeset types

--- src/hu/ssh/github_changelog/formatters/markdown.clj
+++ src/hu/ssh/github_changelog/formatters/markdown.clj
@@ -4,6 +4,15 @@
     [hu.ssh.github-changelog.schema :refer [Tag Change ChangeType]]
     [hu.ssh.github-changelog.markdown :as markdown]
     [schema.core :as s]))
+
+(def type-name-map
+  {:fix "Bug Fixes"
+   :chore "Chores"
+   :feat "Features"})
+
+(s/defn translate-type :- s/Str
+  [type :- s/Str]
+  (or ((keyword type) type-name-map) type))

 (s/defn format-change :- s/Str
   [change :- Change]
@@ -15,7 +24,7 @@

 (s/defn format-changes :- s/Str
   [[type changes :- [Change]]]
-  (str (markdown/h4 type)
+  (str (markdown/h4 (translate-type type))
        (markdown/ul (map format-change changes))))

 (s/defn format-tag :- s/Str


0 is not false

0 is not false

--- src-clj/acha/db.clj
+++ src-clj/acha/db.clj
@@ -115,8 +115,8 @@
       order by timestamp asc limit 1" (- (quot (System/currentTimeMillis) 1000) (* 15 60))])))

 (defn- try-to-update [repo]
-  (update! (db-conn) :repo {:timestamp (quot (System/currentTimeMillis) 1000)}
-    ["id = ? and timestamp = ?" (:id repo) (:timestamp repo)]))
+  (pos? (update! (db-conn) :repo {:timestamp (quot (System/currentTimeMillis) 1000)}
+    ["id = ? and timestamp = ?" (:id repo) (:timestamp repo)])))

 (defn get-next-repo-to-process []
   (when-let [repo (get-next-repo)]


added routes to serve ui files

added routes to serve ui files

Signed-off-by: Yaswanth Yadlapalli <35530af5534c72b66f23c63bd0472e9dbf7cae4a@gmail.com>

--- src/wakata/http.clj
+++ src/wakata/http.clj
@@ -3,15 +3,23 @@
             [compojure.core :refer :all]
             [compojure.route :as route]
             [wakata.controller :as controller]
-            [ring.middleware.json :refer [wrap-json-response]]
-            [ring.util.response :refer [response]]))
+            [ring.middleware.params :refer [wrap-params]]
+            [ring.middleware.json :refer [wrap-json-params wrap-json-response]]
+            [ring.util.response :refer [response resource-response]]))

 (defroutes handler
-  (GET "/schedules" [req] (response (controller/schedules req)))
-  (GET "/rooms" [req] (response (controller/rooms req))))
+  (GET "/schedules" {params :params} (response (controller/schedules params)))
+  (GET "/rooms" [req] (response (controller/rooms req)))
+  (GET "/" [] (resource-response "index.html" {:root "public/dist"}))
+  (route/resources "/" {:root "public/dist"})
+  (route/not-found (resource-response "404.html" {:root "public/dist"})))

 (def app
-  (wrap-json-response handler ))
+  (-> handler
+
+    wrap-params
+    wrap-json-params
+    wrap-json-response))

 (defn start-server [port]
   (jetty/run-jetty app {:port port}))


Revision to root_proiperty_identifier_gen rule

Changed name to match file name (replaced ‘top-level’ with ‘root’)
Added filtering to exclude properties that will be used only in ICE
world

--- resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_property_identifier_gen.clj
+++ resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_property_identifier_gen.clj
@@ -1,7 +1,7 @@
 ;; --------------------------------------------------------
 ;; --------- Top-Level Object Property Assignment ---------
 ;; --------------------------------------------------------
-`{:name "top-level-property-identifier-gen"
+`{:name "root-property-identifier-gen"
   :description "This rule creates an identifier for each top-level object property and types it as a top-level object property identifier (IAO_EXT_0000308)"
   :head ((?/id rdf/type ccp/IAO_EXT_0000308) ;; ccp:top-level object property identifer
          (?/id obo/IAO_0000219 ?/top_level_property)) ;; obo:denotes
@@ -14,5 +14,9 @@
   minus{?top_level_property owl:deprecated true}
   # exclude the oboInOwl:ObsoleteProperty property
   filter (?top_level_property != oboInOwl:ObsoleteProperty)
+  # exclude ICE world properties (IAO, CCP extension ontology, OA ontology)
+  filter (!contains (str(?object_property), 'ext/IAO_'))
+  filter (!contains (str(?object_property), 'obo/IAO_'))
+  filter (!contains (str(?object_property), 'http://www.w3.org/ns/oa#'))
   }"
 }


updating record with key acquisition responses

--- src/er_cassandra/model/unique_key.clj
+++ src/er_cassandra/model/unique_key.clj
@@ -10,8 +10,7 @@
    [qbits.alia.manifold :as aliam]
    [qbits.hayt :as h]
    [er-cassandra.key :as k]
-   [er-cassandra.record :as r]
-   [er-cassandra.record-either :as re]
+   [er-cassandra.record-either :as r]
    [er-cassandra.model.types :as t]
    [er-cassandra.model.util :refer [combine-responses create-lookup-record]])
   (:import [er_cassandra.model.types Model]))
@@ -44,7 +43,7 @@
                   :key key :key-value key-value}]

     (m/with-monad dm/either-deferred-monad
-      (m/mlet [insert-response (re/insert session
+      (m/mlet [insert-response (r/insert session
                                           (:name unique-key-table)
                                           unique-key-record
                                           {:if-not-exists true})
@@ -58,7 +57,7 @@
                         insert-response))

                live-ref? (if-not owned?
-                           (re/select-one session
+                           (r/select-one session
                                           (get-in model [:primary-table :name])
                                           (get-in model [:primary-table :key])
                                           (t/extract-uber-key-value
@@ -71,7 +70,7 @@

                stale-update-response (if (and (not owned?)
                                               (not live-ref?))
-                                       (re/update
+                                       (r/update
                                         session
                                         (:name unique-key-table)
                                         (:key unique-key-table)
@@ -93,13 +92,15 @@
                  :else     [:fail key-desc :notunique] ;; someone else won
                  ))))))

-(defn remove-unique-key
+(defn release-unique-key
   "remove a single unique key"
   [session ^Model model unique-key-table uber-key-value key-value]
   (let [uber-key (t/uber-key model)
-        key (:key unique-key-table)]
+        key (:key unique-key-table)
+        key-desc {:uber-key uber-key :uber-key-value uber-key-value
+                  :key key :key-value key-value}]
     (m/with-monad dm/either-deferred-monad
-      (m/mlet [delete-result (re/delete session
+      (m/mlet [delete-result (r/delete session
                                         (:name unique-key-table)
                                         key
                                         key-value
@@ -110,39 +111,128 @@
                deleted? (m/return (applied? delete-result))]
               (m/return
                (cond
-                 deleted? [:ok :deleted]
-                 :else    [:ok :stale]))))))
-
-(defn acquire-singular-unique-key
-  "attempt to acquire a singular unique key, returning a
-   Deferred[Right[[:ok key info]]] or a Deferred[Right[[:fail key reason]]]"
-  [session ^Model model unique-key-table owner-record]
-  (let [uber-key-value (t/extract-uber-key-value model owner-record)
-        key-value (k/extract-key-value (:key unique-key-table) owner-record)]
-    (acquire-unique-key session model unique-key-table uber-key-value key-value)))
-
-(defn acquire-unique-key-collection
-  "attempt to acquire a set of unique keys. returns a
-   Deferred[Right[[ [:ok key info] | [:fail key reason] ]]]"
-  [session ^Model model unique-key-table owner-record]
-  (let [uber-key-value (t/extract-uber-key-value model owner-record)
-        key-value-coll (k/extract-key-value-collection
-                        (:key unique-key-table)
-                        owner-record)
-        responses (mapv (partial acquire-unique-key
-                                 session
+                 deleted? [:ok key-desc :deleted]
+                 :else    [:ok key-desc :stale]))))))
+
+(defn release-stale-unique-keys
+  [session ^Model model old-record new-record]
+  (combine-responses
+   (mapcat
+    identity
+    (for [t (:unique-key-tables model)]
+      (let [uber-key (t/uber-key model)
+            uber-key-value (t/extract-uber-key-value model new-record)
+            key (:key t)
+            coll (:collection t)]
+        (if coll
+          (let [old-kvs (set (k/extract-key-value-collection key old-record))
+                new-kvs (set (k/extract-key-value-collection key new-record))
+                stale-kvs (filter identity (set/difference new-kvs old-kvs))]
+            (for [kv stale-kvs]
+              (release-unique-key session model t uber-key-value kv)))
+
+          (let [old-kv (k/extract-key-value key old-record)
+                new-kv (k/extract-key-value key new-record)]
+            (when (and old-kv
+                       (not= old-kv new-kv))
+              [(release-unique-key session model t uber-key-value old-kv)]))))))))
+
+(defn acquire-unique-keys
+  [session ^Model model record]
+  (combine-responses
+   (mapcat
+    identity
+    (for [t (:lookup-tables model)]
+      (let [uber-key (t/uber-key model)
+            uber-key-value (t/extract-uber-key-value model record)
+            key (:key t)
+            coll (:collection t)]
+        (if coll
+          (let [kvs (filter identity
+                            (set (k/extract-key-value-collection key record)))]
+            (for [kv kvs]
+              (let [lookup-record (create-lookup-record
+                                   uber-key uber-key-value
+                                   key kv)]
+                (acquire-unique-key session
+                                    model
+                                    t
+                                    uber-key-value
+                                    kv))))
+
+          (when-let [key-value (k/extract-key-value key record)]
+            [(acquire-unique-key session
                                  model
-                                 unique-key-table
-                                 uber-key-value)
-                        key-value-coll)]
-    (combine-responses responses)))
-
+                                 t
+                                 uber-key-value
+                                 key-value)])))))))
+
+(defn update-with-acquire-responses
+  [table acquire-key-responses record]
+  (reduce (fn [[status key-desc _]]
+            (let [coll (:collection table)
+                  key-col (last (:key key-desc))
+                  key-val (last (:key-value key-desc))]
+              (condp = coll
+                :set (when-not (= :ok status)
+                       (assoc record
+                              key-col
+                              (disj (get record key-col)
+                                    key-val)))
+                :list (when-not (= :ok status)
+                        (assoc record
+                               key-col
+                               (filterv #(not= key-val %)
+                                        (get record key-col))))
+
+                :map (when-not (= :ok status)
+                       (assoc record
+                              key-col
+                              (dissoc (get record key-col)
+                                      key-val)))
+
+                :else (when-not (= :ok status)
+                        (assoc record key-col nil)))))
+          record
+          acquire-key-responses))
+
+(defn responses-for-key
+  [match-key responses]
+  (filter (fn [[_ {:keys [key]} _]]
+            (= key match-key))
+          responses))
+
+(defn update-record-by-key-responses
+  [model old-record new-record acquire-key-responses]
+
+  (reduce (fn [nr t]
+            (let [ars (responses-for-key (:key t) acquire-key-responses)]
+              (update-with-acquire-responses t ars nr)))
+          new-record
+          (:unique-key-tables model)))

 (defn acquire-unique-keys
   "attempts to acquire unique keys for an owner... returns
    a Deferred[Right[[:ok updated-owner-record :failed-keys]]] with an updated
    owner record containing only the keys that could be acquired"
-  [session ^Model model owner-record]
+  [session ^Model model new-record]
   (m/with-monad dm/either-deferred-monad
-    (m/mlet [r owner-record]
-            (m/return r))))
+    (m/mlet [old-record (r/select-one session
+                                      (get-in model [:primary-table :name])
+                                      (get-in model [:primary-table :key])
+                                      (t/extract-uber-key-value model new-record))
+
+             release-key-responses (release-stale-unique-keys
+                                    session
+                                    model
+                                    old-record
+                                    new-record)
+             acquire-key-responses (acquire-unique-keys
+                                    session
+                                    model
+                                    new-record)]
+            (m/return
+             (update-record-by-key-responses
+              old-record
+              new-record
+              acquire-key-responses)))))


Remove leftover debug form

Remove leftover debug form

--- src/github_changelog/conventional.clj
+++ src/github_changelog/conventional.clj
@@ -45,8 +45,6 @@
       (if (starts-with? prefix revert-prefix)
         (parse-int pull-id)))))

-(parse-revert {:user "a" :repo "b"} {:title "Revert " :body "Reverts a/b#1"})
-
 (defn parse-pull [config {:keys [title] :as pull}]
   (if-let [pull-id (parse-revert config pull)]
     {:revert-pull pull-id


Sometimes destructuring doesn't add clarity - like here.

--- src/klangmeister/sound/synthesis.cljs
+++ src/klangmeister/sound/synthesis.cljs
@@ -97,17 +97,17 @@
   (reduce connect nodes))

 (defn add
-  "Add together synths by connecting them all to the same gain."
+  "Add together synths by connecting them all to the same upstream and downstream gains."
   [& synths]
   (fn [context at duration]
-    (let [{upstream-input :input upstream-output :output} (-> pass-through (run-with context at duration))
-          {downstream-input :input downstream-output :output} (-> pass-through (run-with context at duration))]
+    (let [upstream (-> pass-through (run-with context at duration))
+          downstream (-> pass-through (run-with context at duration))]
       (doseq [synth synths]
-        (let [{:keys [input output]} (-> synth (run-with context at duration))]
-          (-> output (.connect downstream-input))
-          (when input
-            (-> upstream-output (.connect input)))))
-      (section upstream-input downstream-output))))
+        (let [graph (-> synth (run-with context at duration))]
+          (.connect (:output graph) (:input downstream))
+          (when (:input graph)
+            (.connect (:output upstream) (:input graph)))))
+      (section (:input upstream) (:output downstream)))))

 ; Noise


Make it clear that some graphs don't have either a connectable input or connectable output.

--- src/klangmeister/sound/synthesis.cljs
+++ src/klangmeister/sound/synthesis.cljs
@@ -1,9 +1,20 @@
 (ns klangmeister.sound.synthesis)

-; A synth is a function that returns a section.
+; Definitions
+
 (defn section
   ([input output] {:input input :output output})
   ([singleton] (section singleton singleton)))
+
+(defn generator
+  "A graph of synthesis nodes without an input, so another graph can't connect to it."
+  [node]
+  (section nil node))
+
+(defn sink
+  "A graph of synthesis nodes without an output, so it can't connect to another graph."
+  [node]
+  (section node nil))

 ; Plumbing

@@ -13,7 +24,7 @@
   (synth context at duration))

 (defn destination [context at duration]
-  (section (.-destination context)))
+  (sink (.-destination context)))

 (defn plug [param input context at duration]
   "Plug an input into an audio parameter, accepting both numbers and synths."
@@ -97,7 +108,7 @@
           data (.getChannelData buffer 0)]
       (doseq [i (range sample-rate)]
         (aset data i (generate-bit!)))
-      (section
+      (generator
         (doto (.createBufferSource context)
           (-> .-buffer (set! buffer))
           (.start at))))))
@@ -116,7 +127,7 @@
 (defn oscillator
   [type freq]
   (fn [context at duration]
-    (section
+    (generator
       (doto (.createOscillator context)
         (-> .-frequency .-value (set! 0))
         (-> .-frequency (plug freq context at duration))


remove use of (spec-info)

remove use of (spec-info)

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -57,16 +57,7 @@
     (let [result (unify! (copy parent)
                          {:head (copy head)})]
       (if (not (= :fail result))
-        (do
-          (log/debug (str "overh success: " (get-in parent [:rule]) " -> " (spec-info head) " : "
-                          (strip-refs
-                           (dissoc
-                            head :dag_unify.core/serialized))))
-          (list result))
-        (log/debug (str "overh: fail-path for rule: " (:rule parent) " with head:" (spec-info head) ":"
-                        (dag_unify.core/fail-path
-                         (copy parent)
-                         {:head (copy head)})))))))
+        (list result)))))

 (defn overc [parent comp]
   "add given child as the complement of the parent"


d3 elastic

d3 elastic

--- src/bardo/ease.cljs
+++ src/bardo/ease.cljs
@@ -68,9 +68,12 @@

 (defn elastic
   "Modeled after the damped sine wave y = sin(13PI_2*x)*pow(2, 10 * (x - 1))"
-  [t]
-  (* (.sin js/Math (* 13 PI_2 t))
-     (.pow js/Math 2 (* 10 (dec t)))))
+  ([] (elastic 1))
+  ([a] (elastic a 0.45))
+  ([a p]
+     (let [s (* (/ p PI_2) (.asin js/Math (/ 1 a)))]
+       (fn [t]
+         (+ 1 (* a (.pow js/Math 2 (* -10 t)) (.sin js/Math (* (- t s) (/ PI_2 p)))))))))

 (defn back
   "Modeled after the overshooting cubic y = x^3-x*sin(x*pi)"


Fix small bug

Fix small bug

--- src/main/clojure/clara/rules/java.clj
+++ src/main/clojure/clara/rules/java.clj
@@ -34,7 +34,7 @@
     (JavaWorkingMemory. (apply clara/insert session facts)))

   (retract [this facts]
-    (JavaWorkingMemory. (apply clara/insert session facts)))
+    (JavaWorkingMemory. (apply clara/retract session facts)))

   (fireRules [this]
     (JavaWorkingMemory. (clara/fire-rules session)))


Slightly better example code.

Slightly better example code.

--- src/main/cljc/clojure_club/tile_laying/mbastian.cljc
+++ src/main/cljc/clojure_club/tile_laying/mbastian.cljc
@@ -27,8 +27,7 @@
     compute-slots
     (map (fn [[location slot]] [location (compatible-orientations piece slot)]))
     (filter second)
-    (group-by first)
-    (reduce (fn [m [k v]] (assoc m k (mapcat second v))) {})))
+    (reduce (fn [m [k v]] (update m k into v)) {})))

 ;Coords are arranged as:
 ;[right top left bottom]
@@ -59,4 +58,10 @@
               [0 1] [:L :C :L :C]})

 (all-possible-moves state-0 [:L :L :R :L])
-(all-possible-moves state-0 (rand-nth tiles))+(all-possible-moves state-0 (rand-nth tiles))
+
+(defn random-move [state]
+  (let [[loc moves] (->> tiles rand-nth (all-possible-moves state) seq rand-nth)]
+    (assoc state loc (rand-nth moves))))
+
+;(take 10 (iterate random-move initial-state))


Issue 253: Synchronize the cache of classes to factory function symbols

--- src/main/clojure/clara/rules/durability/fressian.clj
+++ src/main/clojure/clara/rules/durability/fressian.clj
@@ -53,7 +53,8 @@
 ;; factory function created for every Clojure record to improve
 ;; serialization performance.
 ;; See https://github.com/cerner/clara-rules/issues/245 for more extensive discussion.
-(def ^:private ^Map class->factory-fn-sym (WeakHashMap.))
+(def ^:private ^Map class->factory-fn-sym (java.util.Collections/synchronizedMap
+                                           (WeakHashMap.)))

 (defn record-map-constructor-name
   "Return the 'map->' prefix, factory constructor function for a Clojure record."


Extend probemap header fields.

Extend probemap header fields.

--- src/cgdata/core.clj
+++ src/cgdata/core.clj
@@ -495,6 +495,8 @@
             (filter (comp not match-set) columns))
       columns)))

+; This is a really weak attempt to infer types of position columns. We
+; need a better vision.
 (defn find-position-fields
   "Rewrite a list of column objects having a :header attribute,
   collating chrom position columns into position fields, having
@@ -652,7 +654,12 @@
    :chromStart :float
    :chromEnd :float
    :position :position
-   :genes :gene})
+   :genes :gene
+   :thickStart :category
+   :thickEnd :category
+   :blockCount :category
+   :blockSizes :category
+   :blockStarts :category})

 (def ^:private probemap-default-columns
   [:name :genes :chrom :chromStart :chromEnd :strand])
@@ -666,7 +673,12 @@
    #"(?i)strand" :strand
    #"(?i)genes?" :genes
    #"(?i)name" :name
-   #"(?i)id" :name})
+   #"(?i)id" :name
+   #"(?i)thickStart" :thickStart
+   #"(?i)thickEnd" :thickEnd
+   #"(?i)blockCount" :blockCount
+   #"(?i)blockSizes" :blockSizes
+   #"(?i)blockStarts" :blockStarts})

 ; XXX refactor this function pattern. It appears three times.
 (defn probemap-file


Adds eval

Adds eval

--- src/clack/core.cljs
+++ src/clack/core.cljs
@@ -27,7 +27,8 @@

 (def allowed-opts {:filter ["-f" "--filter"]
                    :remove ["-r" "--remove"]
-                   :get-in ["-g" "--get-in" ]})
+                   :get-in ["-g" "--get-in"]
+                   :eval ["-e" "--eval"]})

 (def short-opts (zipmap (map first (vals allowed-opts)) (keys allowed-opts)))
@@ -68,6 +69,8 @@

              :remove (filter qval data)

+             :eval (qval data)
+
              (str "Unknown query type: " qtype))
            queries)))


Fix test

Fix test

--- src/clojars/web.clj
+++ src/clojars/web.clj
@@ -167,7 +167,7 @@
                      (workflows/http-basic)]
          :login-uri "/login"
          :default-landing-uri "/"})
-       (repo/wrap-file-at (config :repo) "/repo")
+       (repo/wrap-file-at (:repo config) "/repo")
        (wrap-resource "public")
        (wrap-file-info))))


:bug: Fix color palette exception.

:bug: Fix color palette exception.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -633,7 +633,7 @@
     (watch [_ state stream]
       (let [selected (get-in state [:workspace-local :selected])
             page-id  (get-in state [:workspace-page :id])]
-        (->> (rx/from selected)
+        (->> (rx/from (seq selected))
              (rx/map (fn [id]
                        (update-shape-recursive id attrs))))))))


set restart policy create form default state

#37

--- src/cljs/swarmpit/component/service/create_config.cljs
+++ src/cljs/swarmpit/component/service/create_config.cljs
@@ -94,13 +94,16 @@
   (state/set-value [] mounts/cursor)
   (state/set-value [] secrets/cursor)
   (state/set-value [] variables/cursor)
-  (state/set-value {:autoredeploy false
-                    :update       {:parallelism   1
-                                   :delay         0
-                                   :failureAction "pause"}
-                    :rollback     {:parallelism   1
-                                   :delay         0
-                                   :failureAction "pause"}} deployment/cursor)
+  (state/set-value {:autoredeploy  false
+                    :restartPolicy {:condition "any"
+                                    :delay     5
+                                    :attempts  0}
+                    :update        {:parallelism   1
+                                    :delay         0
+                                    :failureAction "pause"}
+                    :rollback      {:parallelism   1
+                                    :delay         0
+                                    :failureAction "pause"}} deployment/cursor)
   (state/set-value [] placement/cursor))

 (def init-state-mixin


fixed wrong call

fixed wrong call

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -304,7 +304,7 @@
    decisions. Returns the path to a node, the href
    attrib value and the associated text"
   ([a-processed-page url]
-     (xpaths-hrefs-tokens a-processed-page url (set [])))
+     (page-nodes-hrefs-text a-processed-page url (set [])))

   ([a-processed-page url blacklist]
      (let [a-tags         ($x:node+ ".//a" a-processed-page) ; anchor tags


add docstring for #'buffer-alloc-read

add docstring for #'buffer-alloc-read

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -46,6 +46,11 @@
          {:type ::buffer}))))

 (defn buffer-alloc-read
+  "Synchronously allocates a buffer with the same number of channels as the
+  audio file given by 'path'. Reads the number of samples requested ('n-frames')
+  into the buffer, or fewer if the file is smaller than requested. Reads sound
+  file data from the given starting frame ('start') in the file. If 'n-frames'
+  is less than or equal to zero, the entire file is read."
   ([path]
      (buffer-alloc-read path 0 -1))
   ([path start]


sort-name-callback

sort-name-callback