Adjust naming & removed unused

Adjust naming & removed unused

--- main/src/dda/pallet/dda_backup_crate/domain/schema.clj
+++ main/src/dda/pallet/dda_backup_crate/domain/schema.clj
@@ -39,18 +39,11 @@
    (s/optional-key :db-pre-processing) [s/Str]
    (s/optional-key :db-post-processing) [s/Str]})

-(def ResolvedBackupDbElement
-  "The db backup elements"
-  {:db-user-name s/Str
-   :db-user-passwd s/Str
-   :db-name s/Str
-   (s/optional-key :db-create-options) s/Str
-   (s/optional-key :db-pre-processing) [s/Str]
-   (s/optional-key :db-post-processing) [s/Str]})
-
-(def backup-path-schema
-  {:backup-path (s/either [directory-model/NonRootDirectory] {:root-dir directory-model/NonRootDirectory
-                                                              :subdir-to-save [directory-model/NonRootDirectory]})
+(def BackupPath
+  {:backup-path
+   (s/either [directory-model/NonRootDirectory]
+             {:root-dir directory-model/NonRootDirectory
+              :subdir-to-save [directory-model/NonRootDirectory]})
    (s/optional-key :new-owner) s/Str})

 (def BackupElement
@@ -63,11 +56,11 @@
    #(= (:type %) :file-compressed)
    (merge
     BackupBaseElement
-    backup-path-schema)
+    BackupPath)
    #(= (:type %) :file-plain)
    (merge
      BackupBaseElement
-     backup-path-schema)))
+     BackupPath)))

 (def LocalManagement
   {:gens-stored-on-source-system s/Num})
@@ -83,17 +76,6 @@
                                  :bucket-name s/Str
                                  (s/optional-key :directory-name) s/Str}}})

-(def ResolvedTransportManagement
-  {(s/optional-key :ssh-pull) s/Any
-   (s/optional-key :duplicity-push)
-   {:public-key s/Str
-    :private-key s/Str
-    :passphrase s/Str
-    (s/optional-key :target-s3) {:aws-access-key-id s/Str
-                                 :aws-secret-access-key s/Str
-                                 :bucket-name s/Str
-                                 (s/optional-key :directory-name) s/Str}}})
-
 (def BackupConfig
   {:backup-name s/Str
    :backup-user user/User


Pass on relative-slices/relative-z parameter to simple burst sequence generator

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -351,7 +351,8 @@

 (defn generate-simple-burst-sequence [numFrames use-autofocus
                                       channels slices default-exposure
-                                      property-triggers position-index]
+                                      property-triggers position-index
+                                      relative-slices]
   (println "simple")
   (let [numChannels (max 1 (count channels))
         numSlices (max 1 (count slices))
@@ -387,24 +388,28 @@
                   :task :burst
                   :burst-data events
                   :burst-length (count events)
+                  :relative-z relative-slices
                   :trigger-sequence (merge (make-triggers events) property-triggers)))
          partitioned-events)))

 (defn generate-multiposition-bursts [positions num-frames use-autofocus
-                                     channels slices default-exposure triggers]
+                                     channels slices default-exposure triggers
+                                     relative-slices]
   (process-new-position
     (flatten
       (for [pos-index (range (count positions))]
         (map #(assoc % :position-index pos-index
                      :position (nth positions pos-index))
              (generate-simple-burst-sequence
-               num-frames use-autofocus channels slices default-exposure triggers pos-index))))))
+               num-frames use-autofocus channels slices
+               default-exposure triggers pos-index relative-slices))))))

 (defn generate-acq-sequence [settings runnables]
   (let [{:keys [numFrames time-first positions slices channels
                 use-autofocus default-exposure interval-ms
-                autofocus-skip custom-intervals-ms slices-first]} settings
+                autofocus-skip custom-intervals-ms slices-first
+                relative-slices]} settings
         property-sequences (make-property-sequences (map :properties channels))
         have-multiple-frames (< 1 numFrames)
         have-multiple-positions (< 1 (count positions))
@@ -451,9 +456,9 @@
         (if have-multiple-positions
           (generate-multiposition-bursts
             positions numFrames use-autofocus channels slices
-            default-exposure triggers)
+            default-exposure triggers relative-slices)
           (generate-simple-burst-sequence
             numFrames use-autofocus channels slices
-            default-exposure triggers 0)))
+            default-exposure triggers 0 relative-slices)))
       (generate-default-acq-sequence settings runnables))))


Fix removing group order for sidebar from preference on leaving

--- src/braid/core/client/core/events.cljs
+++ src/braid/core/client/core/events.cljs
@@ -608,14 +608,10 @@
                                 (str "You have been removed from " group-name)
                                 :info)
          (helpers/remove-group group-id)
-         ((fn [state]
-            (if-let [sidebar-order (:groups-order
-                                     (helpers/get-user-preferences state))]
-              (helpers/set-preferences
-                state
-                {:groups-order (into [] (remove (partial = group-id))
-                                     sidebar-order)})
-              state))))
+         (cond->
+             (get-in state [:preferences :groups-order])
+           (update-in [:preferences :groups-order]
+                      (partial filterv #(not= % group-id)))))
      :dispatch [(when (= group-id (state :open-group-id))
                  :redirect-from-root)]}))


Fix bug where Session not getting attached to MimeMessage.

--- src/clj/com/draines/postal/message.clj
+++ src/clj/com/draines/postal/message.clj
@@ -36,7 +36,7 @@
                 (.put "mail.smtp.port" (or port "25"))
                 (.put "mail.smtp.from" (or sender from)))
         session (Session/getInstance props)
-        jmsg (MimeMessage. (:Session msg))]
+        jmsg (MimeMessage. session)]
     (add-recipients! jmsg Message$RecipientType/TO to)
     (add-recipients! jmsg Message$RecipientType/CC cc)
     (add-recipients! jmsg Message$RecipientType/BCC bcc)


Minor profile tabs fix

Minor profile tabs fix

--- src/cljs/salava/profile/ui/helper.cljs
+++ src/cljs/salava/profile/ui/helper.cljs
@@ -308,17 +308,18 @@
        (admintool user-id "user")])))

 (defn add-page [state]
+  (let [refresh-tabs (memoize (fn [] (pe/save-profile state nil false)))]
    (when (:edit-mode @state) [:li.nav-item.dropdown.addnew [:a.dropdown-toggle {:data-toggle "dropdown"} [:i.fa.fa-plus-square]]
                                 [:ul.dropdown-menu
                                  [:li [:a {:href "#" :on-click #(do
                                                                  (.preventDefault %)
-                                                                 (mo/open-modal [:page :my] {:tab-atom (cursor state [:tabs])} {:hidden (fn [] (pe/save-profile state nil false))}))}
+                                                                 (mo/open-modal [:page :my] {:tab-atom (cursor state [:tabs])} {:hidden refresh-tabs #_(fn [] (pe/save-profile state nil false))}))}

                                        (t :profile/Addexistingpage)]]
                                  [:li [:a {:href "#" :on-click #(do
                                                                  (.preventDefault %)
                                                                  (create-page)
-                                                                 #_(as-> (first (plugin-fun (session/get :plugins) "my" "create_page")) f (when f (f)) ))} (t :profile/Createnewpage)]]]]))
+                                                                 #_(as-> (first (plugin-fun (session/get :plugins) "my" "create_page")) f (when f (f)) ))} (t :profile/Createnewpage)]]]])))

 (defn page-content [page-id page state]
  (let [index (.indexOf (map :id @(cursor state [:tabs])) page-id)]


Implemented some fuzzy-FCA stuff

Implemented some fuzzy-FCA stuff

completely untested.

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

--- src/conexp/contrib/factor_analysis.clj
+++ src/conexp/contrib/factor_analysis.clj
@@ -172,7 +172,39 @@

 ;;;

-
+(defn fuzzy-object-derivation
+  "Computes the fuzzy derivation of the fuzzy set C of objects in
+  the given context."
+  [context C]
+  (let [inz (incidence context)]
+    (map-by-fn (fn [m]
+                 (reduce (fn [a g]
+                           (f-and a (f-impl (C g) (inz [g m]))))
+                         1
+                         (objects context)))
+               (attributes context))))
+
+(defn fuzzy-attribute-derivation
+  "Computes the fuzzy derivation of the fuzzy set D of attributes in
+  the given context."
+  [context D]
+  (let [inz (incidence context)]
+    (map-by-fn (fn [g]
+                 (reduce (fn [a m]
+                           (f-and a (f-impl (D m) (inz [g m]))))
+                         1
+                         (attributes context)))
+               (objects context))))
+
+(defn- fuzzy-oplus-a
+  ""
+  [context U D a j]
+  (let [D+ (assoc D j a),
+        D+down (fuzzy-attribute-derivation context D+),
+        D+down-up (fuzzy-object-derivation context D+up)]
+    (set-of [k l] [[k l] U,
+                   :when (>= (f-star (D+down k) (D+down-up l))
+                             ((incidence context) [k l]))])))

 ;;;


Take a stab at auto-migrating v0 file store layouts.

--- src/blocks/store/file.clj
+++ src/blocks/store/file.clj
@@ -39,13 +39,14 @@
     java.time.Instant))

+;; ## Storage Layout
+
 (def layout-version
   "The current supported storage layout version."
-  "1")
-
-
-
-;; ## Metadata
+  "v1")
+
+
+;; ### Metadata

 (defn- meta-file
   "Construct the store-level metadata properties file from the store root."
@@ -77,8 +78,7 @@
     {:version layout-version}))

-
-;; ## Landing Area
+;; ### Landing Area

 (defn- landing-dir
   "Construct the landing directory from the store root."
@@ -98,16 +98,7 @@
       (.deleteOnExit))))

-(defn- rm-r
-  "Recursively removes a directory of files."
-  [^File path]
-  (when (.isDirectory path)
-    (run! rm-r (.listFiles path)))
-  (.delete path))
-
-
-
-;; ## Block Files
+;; ### Block Files

 (def ^:private prefix-length
   "Number of characters to use as a prefix for top-level directory names."
@@ -184,6 +175,81 @@
       (meta stats))))

+;; ### Initialization
+
+(defn- v0-subdir?
+  "True if the given directory is a v0 block subdirectory."
+  [^File subdir]
+  (and (.isDirectory subdir)
+       (= prefix-length (count (.getName subdir)))
+       (re-matches #"[0-9a-f]+" (.getName subdir))))
+
+
+(defn- migrate-v0!
+  "Migrate an existing v0 layout to v1."
+  [^File root]
+  (let [blocks (blocks-dir root)]
+    (.mkdirs blocks)
+    (run!
+      (fn move-block-dir
+        [^File subdir]
+        (when (v0-subdir? subdir)
+          (.renameTo subdir (io/file blocks (.getName subdir)))))
+      (.listFiles root))))
+
+
+(defn- initialize-layout!
+  "Initialize the block store layout by writing out metadata and pre-creating
+  some directories. Returns the layout meta-properties."
+  [store]
+  (let [^File root (:root store)]
+    (if (empty? (.listFiles root))
+      ; Root doesn't exist or is empty, so initialize the storage layout.
+      (do (.mkdirs (blocks-dir root))
+          (.mkdirs (landing-dir root))
+          (write-meta-properties root))
+      ; Try loading store metadata.
+      (let [properties (read-meta-properties root)]
+        (if (nil? properties)
+          ; No meta-properties file; check for v0 layout.
+          (do
+            ; Check for unknown file content in root.
+            (when-not (every? v0-subdir? (.listFiles root))
+              (throw (ex-info
+                       (str "Detected unknown files in block store at " root)
+                       {:files (vec (.listFiles root))})))
+            ; Possible v0 store. Abort unless configured to migrate.
+            (when-not (:auto-migrate? store)
+              (throw (ex-info
+                       (str "Detected v0 file block store layout at " root)
+                       {:root root})))
+            ; Migrate to v1 layout.
+            (log/warn "Automatically migrating file block store layout at"
+                      root "from v0 ->" layout-version)
+            (migrate-v0! root)
+            (.mkdirs (landing-dir root))
+            (write-meta-properties root))
+          ; Check for known layout version.
+          (let [version (:version properties)]
+            (when (not= layout-version version)
+              (throw (ex-info
+                       (str "Unknown storage layout version " (pr-str version)
+                            " does not match supported version "
+                            (pr-str layout-version))
+                       {:supported layout-version
+                        :properties properties})))
+            ; Layout matches the expected version.
+            properties))))))
+
+
+(defn- rm-r
+  "Recursively removes a directory of files."
+  [^File path]
+  (when (.isDirectory path)
+    (run! rm-r (.listFiles path)))
+  (.delete path))
+
+

 ;; ## File Store

@@ -196,18 +262,9 @@

   (start
     [this]
-    ; TODO: auto-migrate v0 layouts?
-    (let [properties (or (read-meta-properties root)
-                         (write-meta-properties root))
+    (let [properties (initialize-layout! this)
           version (:version properties)]
-      (when (not= layout-version version)
-        (throw (ex-info
-                 (str "Unknown storage layout version " (pr-str version)
-                      " does not match supported version "
-                      (pr-str layout-version))
-                 {:supported layout-version
-                  :properties properties})))
-      (log/debug "Using storage layout version" version)
+      ;(log/debug "Using storage layout version" version)
       (assoc this :version version)))

@@ -287,8 +344,8 @@
   (-erase!
     [this]
     (d/future
-      (rm-r (landing-dir root))
-      (rm-r (blocks-dir root))
+      (run! rm-r (.listFiles (landing-dir root)))
+      (run! rm-r (.listFiles (blocks-dir root)))
       true)))


Handle the case where an upload produces no validation errors

So far this was not implemented (as it never happened).

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -321,10 +321,11 @@
                                      year issue
                                      (if (= fmt :all-formats) "upload" "upload-full")) "Cancel")
               (form/submit-button {:class "btn btn-default"} "Upload Anyway"))))
-          (do
-            ;; FIXME: add the file
-            ;; and redirect to the index
-            (response/redirect-after-post (format "/%s/%s" year issue)))))
+          ;; if there are no problems just upload the file.
+          (upload request year issue fmt
+                   ;; Repackage the items as edn as the api of the upload function expects
+                   ;; it that way. Wasteful I know, but simple.
+                  (prn-str items))))
       ;; if the file is empty go back to the upload form
       (if (= fmt :all-formats)
         (upload-form request year issue ["No file selected"])
@@ -440,10 +441,12 @@
               (form/hidden-field "fmt" fmt)
               (layout/button (format "/%s/%s/custom" year issue) "Cancel")
               (form/submit-button {:class "btn btn-default"} "Upload Anyway"))))
-          (do
-            ;; FIXME: add the file
-            ;; and redirect to the index
-            (response/redirect-after-post (format "/%s/%s" year issue)))))
+          ;; if there are no problems just produce a response with a
+          ;; custom catalog.
+          (custom request year issue query customer fmt
+                  ;;  Repackage the items as edn as the api of the custom function expects
+                  ;;  it that way. Wasteful, I know, but simple.
+                  (prn-str items))))
       ;; if the file is empty go back to the upload form
       (custom-form request year issue ["No file selected"]))))


Fix a bug in the scripts evaluation

Fix a bug in the scripts evaluation

--- src/cider_ci/ex/trial.clj
+++ src/cider_ci/ex/trial.clj
@@ -144,9 +144,15 @@

 (defn set-final-state [trial]
   (let [passed?  (->> (get-params-atom trial)
+                      (debug/identity-with-logging 'cider-ci.ex.trial)
+                      deref
+                      (debug/identity-with-logging 'cider-ci.ex.trial)
                       :scripts
+                      (into [])(debug/identity-with-logging 'cider-ci.ex.trial)
                       (filter #(-> % deref :ignore_state not))
-                      (every? #(= "passed" (-> % deref :state))))
+                      (into [])(debug/identity-with-logging 'cider-ci.ex.trial)
+                      (every? #(= "passed" (-> % deref :state)))
+                      (debug/identity-with-logging 'cider-ci.ex.trial))
         final-state (if passed? "passed" "failed")]
     (swap! (get-params-atom trial)
            #(conj %1 {:state %2, :finished_at (time/now)})


Fix type in previous commit

Fix type in previous commit

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -633,7 +633,7 @@
           (parse-invoke env form))
         (analyze env mform name)))))

-(declare analyze-wrap-map)
+(declare analyze-wrap-meta)

 (defn analyze-map
   [env form name]


Add route for viewport bounded query

Add route for viewport bounded query

--- src/clj/gtfve/handler.clj
+++ src/clj/gtfve/handler.clj
@@ -60,6 +60,14 @@
                        (q/stops-search query pull)
                        (q/stops-search query))))

+(defresource viewport [bbox]
+  :available-media-types ["text/html"
+                          "application/edn"
+                          "application/json"]
+  :allowed-methods [:get]
+  :last-modified (fn [_] (begin-of-last-minute))
+  :handle-ok (fn [_] (q/viewport bbox)))
+
 (defroutes routes
   (GET "/" [] (render-file "templates/index.html" {:dev (env :dev?)}))
   (ANY "/pull" {{spec :spec e :e} :params} (gtfs-trips spec e))
@@ -67,6 +75,7 @@
   (ANY "/routes" [] gtfs-routes)
   (ANY "/routes/:id" [id] (gtfs-route id))
   (GET "/stops-search" [query pull] (gtfs-stops-search query pull))
+  (GET "/viewport" [bbox] ())
   (resources "/")
   (not-found "Not Found"))


Add deprecation metadata on lambdacd.utils (was deprecated in 0.12.1)

--- src/clj/lambdacd/util.clj
+++ src/clj/lambdacd/util.clj
@@ -1,4 +1,5 @@
 (ns lambdacd.util
+  {:deprecated "0.12.1"}
   (:import (java.nio.file.attribute FileAttribute))
   (:require [clojure.data.json :as json]
             [lambdacd.util.internal.bash :as bash-utils]


Fixup language not moved to config

Fixup language not moved to config

--- src/cljs/geoforms/db.cljs
+++ src/cljs/geoforms/db.cljs
@@ -263,7 +263,7 @@

 (defn snippet [key]
-  (get-in @app-cms [config/language key]))
+  (get-in @app-cms [language key]))

 (load-fixtures!
  ideas-ref


Names

Names

--- src/clojurecraft/core.clj
+++ src/clojurecraft/core.clj
@@ -10,6 +10,7 @@
      :login 0x01
      :handshake 0x02
      :chat 0x03
+     :timeupdate 0x04
 })
 (def packet-types (apply assoc {} (mapcat reverse packet-ids)))

@@ -29,28 +30,28 @@

 ; Writing Data ---------------------------------------------------------------------
-(defn writ-byte [conn i]
+(defn -write-byte [conn i]
       (println (str "-> PACKET ID: " (Integer/toHexString i)))
       (doto (:out @conn)
          (.writeByte (int i))))

-(defn writ-short [conn i]
+(defn -write-short [conn i]
       (println (str "-> SHORT: " i))
       (doto (:out @conn)
          (.writeShort (int i))))

-(defn writ-int [conn i]
+(defn -write-int [conn i]
       (println (str "-> INT: " i))
       (doto (:out @conn)
          (.writeInt (int i))))

-(defn writ-long [conn i]
+(defn -write-long [conn i]
       (println (str "-> LONG: " i))
       (doto (:out @conn)
          (.writeLong (int i))))

-(defn writ-string16 [conn s]
-      (writ-short conn (count s))
+(defn -write-string16 [conn s]
+      (-write-short conn (count s))
       (println (str "-> STRING: " s))
       (doto (:out @conn)
          (.writeChars s)))
@@ -58,20 +59,25 @@

 ; Writing Packets ------------------------------------------------------------------
 (defn write-packet-keepalive [conn _]
-      (writ-byte conn (:handshake packet-ids)))
+      (-write-byte conn (:handshake packet-ids)))

 (defn write-packet-handshake [conn {username :username}]
-      (writ-byte conn (:handshake packet-ids))
+      (-write-byte conn (:handshake packet-ids))

-      (writ-string16 conn username))
+      (-write-string16 conn username))

 (defn write-packet-login [conn {version :version, username :username}]
-      (writ-byte conn (:login packet-ids))
+      (-write-byte conn (:login packet-ids))

-      (writ-int conn version)
-      (writ-string16 conn username)
-      (writ-long conn 0)
-      (writ-byte conn 0))
+      (-write-int conn version)
+      (-write-string16 conn username)
+      (-write-long conn 0)
+      (-write-byte conn 0))
+
+(defn write-packet-chat [conn {message :message}]
+      (-write-byte conn (:chat packet-ids))
+
+      (-write-string16 conn message))

 ; Writing Wrappers -----------------------------------------------------------------
@@ -88,19 +94,19 @@

 ; Reading Data ---------------------------------------------------------------------
-(defn red-byte [conn]
+(defn -read-byte [conn]
    (let [b (.readByte (:in @conn))]
      b))

-(defn red-int [conn]
+(defn -read-int [conn]
    (let [i (.readInt (:in @conn))]
      i))

-(defn red-long [conn]
+(defn -read-long [conn]
    (let [i (.readLong (:in @conn))]
      i))

-(defn red-string16 [conn]
+(defn -read-string16 [conn]
   (let [str-len (.readShort (:in @conn))
         s (apply str (repeatedly str-len #(.readChar (:in @conn))))]
     s))
@@ -108,21 +114,27 @@

 ; Reading Packets ------------------------------------------------------------------
 (defn read-packet-keepalive [conn]
-      (println "OMG got a keepalive")
       nil)

 (defn read-packet-handshake [conn]
-      (println "OMG got a handshake")
       (-> {}
-          (assoc :hash (red-string16 conn))))
+          (assoc :hash (-read-string16 conn))))

 (defn read-packet-login [conn]
-      (println "OMG got a login")
       (-> {}
-          (assoc :eid (red-int conn))
-          (assoc :unknown (red-string16 conn))
-          (assoc :seed (red-long conn))
-          (assoc :dimension (red-byte conn))))
+          (assoc :eid (-read-int conn))
+          (assoc :unknown (-read-string16 conn))
+          (assoc :seed (-read-long conn))
+          (assoc :dimension (-read-byte conn))))
+
+(defn read-packet-chat [conn]
+      (-> {}
+          (assoc :message (-read-string16 conn))))
+
+(defn read-packet-timeupdate [conn]
+      (-> {}
+          (assoc :time (-read-long conn))))
+

 (defn read-packet [conn packet-id]
       (let [packet-id (int packet-id)
@@ -133,6 +145,8 @@
             (= packet-type :keepalive) (read-packet-keepalive conn)
             (= packet-type :handshake) (read-packet-handshake conn)
             (= packet-type :login) (read-packet-login conn)
+            (= packet-type :chat) (read-packet-chat conn)
+            (= packet-type :timeupdate) (read-packet-timeupdate conn)
             :else (str "UNKNOWN PACKET TYPE: " packet-id)
             ))
         (println "\n\n\n")))
@@ -144,14 +158,14 @@
     (write-packet conn :handshake {:username "timmy"})

     ; Get handshake
-    (let [packet-id (red-byte conn)]
+    (let [packet-id (-read-byte conn)]
       (read-packet conn packet-id))

     ; Send login
     (write-packet conn :login {:version 13 :username "timmy"})

     ; Get login
-    (let [packet-id (red-byte conn)]
+    (let [packet-id (-read-byte conn)]
       (read-packet conn packet-id)))

 (defn conn-handler [conn]
@@ -167,6 +181,6 @@

 ; REPL -----------------------------------------------------------------------------
-(def server (connect minecraft-local))
+;(def server (connect minecraft-local))
 ;(disconnect server)


Improved docstrings on compojure.handler functions

--- src/compojure/handler.clj
+++ src/compojure/handler.clj
@@ -7,14 +7,17 @@
                          cookies
                          session]))

-(defn- with-opts
-  [routes middleware opts]
+(defn- with-opts [routes middleware opts]
   (if opts
     (middleware routes opts)
     (middleware routes)))

 (defn api
-  "Create a handler suitable for a web API."
+  "Create a handler suitable for a web API. This adds the following
+  middleware to your routes:
+    - wrap-params
+    - wrap-nested-params
+    - wrap-keyword-params"
   [routes]
   (-> routes
       wrap-keyword-params
@@ -22,7 +25,17 @@
       wrap-params))

 (defn site
-  "Create a handler suitable for a standard website."
+  "Create a handler suitable for a standard website. This adds the
+  following middleware to your routes:
+    - wrap-session
+    - wrap-cookies
+    - wrap-multipart-params
+    - wrap-params
+    - wrap-nested-params
+    - wrap-keyword-params
+
+  A map of options may also be provided. These keys are provided:
+    :session - a map of session middleware options"
   [routes & [opts]]
   (-> (api routes)
       (wrap-multipart-params)


reverted set-custom-resource-path!

reverted set-custom-resource-path!

--- src/selmer/util.clj
+++ src/selmer/util.clj
@@ -12,9 +12,10 @@

 (defn set-custom-resource-path!
   [path]
-  (alter-var-root #'*custom-resource-path* (constantly path))
-  (when (thread-bound? #'*custom-resource-path*)
-    (set! *custom-resource-path* path)))
+  (alter-var-root #'*custom-resource-path*
+                  (constantly path)
+                  (when (thread-bound? #'*custom-resource-path*)
+                    (set! *custom-resource-path* path))))

 (def ^:dynamic *escape-variables* true)


Implimentation total/caste REST Service

Implimentation total/caste REST Service

--- src/dataanalysis/core.clj
+++ src/dataanalysis/core.clj
@@ -25,6 +25,13 @@
 (defn lfpr-caste [tstring]
   (db/get-lfpr-by-caste {:caste tstring}))

+(defn wpr-caste [tstring]
+  (db/get-wpr-by-caste {:caste tstring}))
+
+(defn umr-caste [tstring]
+  (db/get-umr-by-caste {:caste tstring}))
+
+
 (defn lfpr-caste-type [t1string t2String ]
   (db/get-lfpr-by-casteandtype {:caste t1string :type t2String}))

@@ -44,6 +51,21 @@
        (rr/content-type
         (rr/response (lfpr-caste caste))
         content-type))
+  (GET "/wpr/caste/:caste" [caste]
+       (rr/content-type
+        (rr/response (wpr-caste caste))
+        content-type))
+
+  (GET "/umr/caste/:caste" [caste]
+       (rr/content-type
+        (rr/response (umr-caste caste))
+        content-type))
+
+  (GET "/total/caste/:caste" [caste] (rr/content-type
+                                      (rr/response {:lfpr (lfpr-caste caste)
+                                                    :wpr (wpr-caste caste)
+                                                    :umr (umr-caste caste)})
+                                      "application/json; charset=utf-8"))

   (GET "/lfpr/caste/:caste/:type" [caste type]
        (rr/content-type
@@ -73,6 +95,10 @@
   (GET "/deca" [] (rr/content-type
                    (rr/response  (db/get-deca))
                    "application/json; charset=utf-8"))
+  (GET "/deca1" [] (rr/content-type
+                    (rr/response  (db/get-deca1))
+                    "application/json; charset=utf-8"))
+
   (GET "/all" [] (rr/content-type
                   (rr/response {:lfp (db/get-lfp)
                                 :wp (db/get-wp)
@@ -104,5 +130,5 @@
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
-  (jetty/run-jetty app {:port 8080
+  (jetty/run-jetty app {:port 8091
                         :join? false}))


Fix createMixin class (so defclass works)

--- src/quiescent.clj
+++ src/quiescent.clj
@@ -41,12 +41,11 @@
        ~@(for [[mname margs & mbody] obj-meths]
            `(set! (. ~o ~(symbol (str \- (name mname))))
                   (fn ~(subvec margs 1)
-                    (this-as
-                      ~(first margs)
+                    (cljs.core/this-as ~(first margs)
                       ~@mbody))))
        ~(if (empty? proto+specs)
           o
-          `(specify! ~o ~@proto+specs)))))
+          `(cljs.core/specify! ~o ~@proto+specs)))))

 (defmacro createClass [& specs]
   `(js/React.createClass (createMixin ~@specs)))


Add main-db function to get datasource from connection

--- src/madouc/db.clj
+++ src/madouc/db.clj
@@ -18,5 +18,8 @@
                            (env :db-password)))
   :stop (close-datasource con))

+(defn main-db
+  []
+  {:datasource con})

-
+(hugsql/def-db-fns "sql/queries.sql")


good so far

good so far

--- src/epicea/typed/core.clj
+++ src/epicea/typed/core.clj
@@ -81,6 +81,14 @@
                           :sized-type ::sized-type
                           :array ::array
                           :dynamic ::dynamic))
+
+(defn export-primitive [x]
+  [:export x])
+
+;(defmultiple export-typed-value first
+;  (:primitive [x] (export-primitive x)))
+(defn export-typed-value [x]
+  [:export x])

 ;; How to specify one:
@@ -182,16 +190,13 @@
                             (access/getx expr-type expr))
   (:default
    [argmap expr cb]
-   (cb argmap {:type (spec/conform ::type (access/getx expr-value expr))
-               :repr expr})))
+   (cb argmap (spec/conform ::type (access/getx expr-value expr)))))

 (def empty-argmap {})

 (defn value? [x]
-  (and (map? x)
-       (contains? x :type)
-       (contains? x :repr)))
+  true)

 (defn check-is-value [x]
   (if (not (value? x))
@@ -207,9 +212,6 @@
               (fn [new-argmap x]
                 (check-is-value x)
                 (compile-exprs new-argmap (rest exprs) cb)))))
-
-(defn export-typed-value [value]
-  [:export value])

 (defmacro with-typed [& args]
   (let [parsed (spec/conform ::exprs args)]


Provide a frame title.

Provide a frame title.

--- src/fm/simrunner/main.clj
+++ src/fm/simrunner/main.clj
@@ -19,9 +19,11 @@
 (defn run [& args]
   @(gui/gui-do
     (let [frame (view/simrunner-frame)
-          view  (-> frame :contents :simrunner-view)]
+          view  (-> frame :contents :simrunner-view)
+          frame (:widget frame)]
       (wiring/wire-up view on-event)
-      (-> frame :widget .show))))
+      (.setTitle frame "SimRunner (c) 2014 DEINC")
+      (.show frame))))

 (defn -main [& args]
   (apply run args))


code cleanup

code cleanup

--- src/tween/core.cljs
+++ src/tween/core.cljs
@@ -10,6 +10,12 @@
 (defonce Tween js/createjs.Tween)
 (defonce Ticker js/createjs.Ticker)
 (defonce Ease js/createjs.Ease)
+
+(def ltr-movement [{:axis :x :pos 400 :t 800 :ease 4}
+                   {:axis :y :pos 75 :t 500 :ease 2 :alpha 0}
+                   {:axis :y :pos 125 :t 100 :alpha 0}
+                   {:axis :y :pos 100 :t 500 :ease 2 :alpha 1}
+                   {:axis :x :pos 100 :t 800 :ease 2}])

 ;; Sample code from http://www.createjs.com/getting-started/tweenjs

@@ -95,37 +101,30 @@
        [:canvas {:id id :height height :width width}])}))

 (defn home-page []
-  (let [ltr-movement [{:item 1 :axis :x :pos 400 :t 800 :ease 4}
-                      {:item 1 :axis :y :pos 75 :t 500 :ease 2 :alpha 0}
-                      {:item 1 :axis :y :pos 125 :t 100 :alpha 0}
-                      {:item 1 :axis :y :pos 100 :t 500 :ease 2 :alpha 1}
-                      {:item 1 :axis :x :pos 100 :t 800 :ease 2}]]
-    [:div
-     [:h2 "Welcome to Reagent"]
-     [:p "Tween sample from main page integrated with reagent-frontend
-      template not using externs though"]
-     [TweenMovement {:id "demoCanvas"
-                     :height 250
-                     :width 600
-                     :item {:id 1
-                            :type :circle
-                            :fill "black"
-                            :r 50
-                            :x 100
-                            :y 100}
-                     :fps-ticker 60
-                     :movement ltr-movement}]
-     [TweenMovement {:id "demoCanvas2"
-                     :height 250
-                     :width 600
-                     :item {:id 1
-                            :type :circle
-                            :fill "red"
-                            :r 50
-                            :x 400
-                            :y 100}
-                     :fps-ticker 60
-                     :movement (reverse ltr-movement)}]]))
+  [:div
+   [:h2 "Welcome to Reagent"]
+   [:p "Tween sample from main page integrated with reagent-frontend
+    template not using externs though"]
+   [TweenMovement {:id "demoCanvas"
+                   :height 250
+                   :width 600
+                   :item {:type :circle
+                          :fill "black"
+                          :r 50
+                          :x 100
+                          :y 100}
+                   :fps-ticker 60
+                   :movement ltr-movement}]
+   [TweenMovement {:id "demoCanvas2"
+                   :height 250
+                   :width 600
+                   :item {:type :circle
+                          :fill "red"
+                          :r 50
+                          :x 400
+                          :y 100}
+                   :fps-ticker 60
+                   :movement (reverse ltr-movement)}]])

 ;; -------------------------
 ;; Initialize app


Fix post-AOT cleanup to use package-based deletion heuristic.

We had it so every .class file had to correspond with a .clj file in
src/, but sometimes there are outliers that don't match up. So instead
we now ensure that there's a directory in src/ that matches the
package of each .class file.

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -177,21 +177,19 @@
           "NUL"
           "/dev/null")))

-(defn- has-corresponding-src?
-  "Test if the given class file path exists in the source folder."
+(defn- has-source-package?
+  "Test if the class file's package exists as a directory in :source-path."
   [project f]
-  (.exists (file (:source-path project)
-                 (-> (.getAbsolutePath f)
-                     (.replaceAll "\\$\\w*\\.class$" ".clj")
-                     (.replaceAll "__init\\.class$" ".clj")
-                     (.replaceAll "\\.class$" ".clj")
-                     (.replace (str (:compile-path project) "/") "")))))
+  (.isDirectory (doto (file (.replace (.getParent f)
+                                      (:compile-path project)
+                                      (:source-path project)))
+                  println)))

 (defn delete-non-project-classes [project]
   (when (and (not= :all (:aot project))
              (not (:keep-non-project-classes project)))
     (doseq [f (file-seq (file (:compile-path project)))
-            :when (and (.isFile f) (not (has-corresponding-src? project f)))]
+            :when (and (.isFile f) (not (has-source-package? project f)))]
       (.delete f))))

 (defn- status [code msg]


Use ->cm-doc where appropriate

Use ->cm-doc where appropriate

--- src/lt/objs/document.cljs
+++ src/lt/objs/document.cljs
@@ -14,10 +14,12 @@
 (defn create* [info]
   (.Doc js/CodeMirror (:content info) (:mime info)))

+(defn ->cm-doc [doc]
+  (-> @doc :doc))
+
 (defn linked* [doc info]
-  (let [{:keys [from to shared-history type]} info
-        cm-doc (-> @doc :doc)]
-    (.linkedDoc cm-doc (clj->js {:from from
+  (let [{:keys [from to shared-history type]} info]
+    (.linkedDoc (->cm-doc doc) (clj->js {:from from
                                  :to to
                                  :sharedHist shared-history
                                  :mode type}))))
@@ -42,7 +44,7 @@
                   :triggers #{:close.force}
                   :reaction (fn [this]
                               (when-let [root (:root @this)]
-                                (.unlinkDoc (:doc @this) (:doc @root))
+                                (.unlinkDoc (->cm-doc this) (->cm-doc root))
                                 (object/update! root [:sub-docs] disj this))
                               (object/destroy! this)))

@@ -84,9 +86,6 @@
                              {:doc (linked* doc info) :root doc}))]
      (object/add-tags neue [:document.linked])
      (object/update! doc [:sub-docs] conj neue))))
-
-(defn ->cm-doc [doc]
-  (-> @doc :doc))

 (defn ->snapshot [doc]
   (let [d (->cm-doc doc)


Removed unnecessary whitespace

Removed unnecessary whitespace

--- src/rmfu/core.clj
+++ src/rmfu/core.clj
@@ -203,8 +203,7 @@
           (wrap-file "resources/public")))                  ;; server static files from this directory

 (defn -main [port]
-    (jetty/run-jetty app {:port (Integer. port)}))
+  (jetty/run-jetty app {:port (Integer. port)}))

 (defn -dev [port]
-
   (jetty/run-jetty (wrap-reload #'app) {:port (Integer. port)}))


Implimentation of Create-user REST service

--- src/rrms/core.clj
+++ src/rrms/core.clj
@@ -15,6 +15,7 @@
             [clj-time.format :as f]
             [clj-time.coerce :as c]
             [clojure.string :as st]
+            [crypto.password.bcrypt :as pwds]
             )
   (:gen-class))

@@ -104,6 +105,20 @@
              (rr/response (db/get-all-documents))
              content-type))))

+  (POST "/users/create" {body :body}
+        (let [{fn "firstname" ln "lastname"
+               em "email"
+               pwd "password" ro "role" }
+              body]
+          (rr/content-type
+           (rr/response
+            (db/create-user {:firstname fn
+                             :lastname ln
+                             :email em
+                             :password (pwds/encrypt pwd)
+                             :role ro}))
+           content-type)))
+
   (POST "/documents/update"
         {body :body}
         (let [{id "id"


some param checks for ie. q/log

some param checks for ie. q/log

--- src/runtime/q.clj
+++ src/runtime/q.clj
@@ -581,13 +581,16 @@
 ;                  ["\n`"])
 ;                )

-              (list `apply `str
-                (concat ['list "\n"
-                         "The fail msg is:\n`\n"]
-                  ;evalled
-                  restOfFailMsg
-                  ["\n`"])
-                )
+              ;(do
+               ; (prn restOfFailMsg)
+                (list `apply `str
+                  (concat ['list "\n"
+                           "The fail msg is:\n`\n"]
+                    ;evalled
+                    restOfFailMsg
+                    ["\n`"])
+                  )
+                ;)
 ;              )
               ;)
             )
@@ -1167,13 +1170,7 @@
   )

-(defmacro ^:private priv_functionget [& msg2]
-  `(fn [x#]
-     (logAny
-       (or ~'loglevel :debug)
-       x# ~@msg2)
-     )
-  )
+

 #_(defn ^:private priv_functionget [& msg2]
   '(fn [x#]
@@ -1183,7 +1180,39 @@
      )
   )

-(defn assumedLogLevel [loglevel]
+;TODO:something like (or x 1) but we check x against some invariants if it's non-truthy
+#_(defn fallback
+  [original & fallbacks]
+
+  )
+
+(defn assumedValidIfPresent [validityfn presentfn thing & failmsg]
+  {:pre [(assumedTrue
+           [
+            (ifn? validityfn)
+            "you didn't pass a valid ifn? as validityfn"
+            "you passed `"
+            validityfn
+            "`"
+            ]
+           [
+            (ifn? presentfn)
+            "you didn't pass a valid ifn? as presentfn"
+            "you passed `"
+            presentfn
+            "`"
+            ]
+           )]}
+  (cond (presentfn thing)
+    (assumedTrue [(validityfn thing)
+                  failmsg])
+    :else
+    ;not-present, not checked and return true
+    true
+    )
+  )
+
+(defn assumedValidLogLevel [loglevel]
   (assumedTrue [
                 (keyword? loglevel)
                 "loglevel must be a keyword ie. :info or :debug"
@@ -1191,13 +1220,21 @@
                 ])
   )

-(defn assumedShift [shift]
+(defn assumedValidShift [shift]
   (assumedTrue [(number? shift)
                 "the shift must be a number, you passed `"
                 shift "`"
                 ])
   )

+(defmacro ^:private priv_functionget [& msg2]
+  `(fn [x#]
+     (logAny
+       (or ~'loglevel :debug) ;TODO: check logLevel is valid
+       x# ~@msg2)
+     )
+  )
+
 (defn showHere
 "
 optional inputs:
@@ -1206,6 +1243,10 @@
 rest = strings to be joined with space between them; or nil to skip
 "
   [& [shift loglevel  :as all]]
+  {:pre [
+         (assumedValidIfPresent assumedValidShift notnil? shift)
+         (assumedValidIfPresent assumedValidLogLevel notnil? loglevel)
+         ]}
   (showLocation (let [msg (nthrest all 2)]
                   (cond (empty? msg)
                     (priv_functionget)
@@ -1234,20 +1275,20 @@

 (defn logShift [shift loglevel & anyMsg]
-  {:pre [(assumedLogLevel loglevel)
-         (assumedShift shift)
+  {:pre [(assumedValidLogLevel loglevel)
+         (assumedValidShift shift)
          ]}
   (apply showHere (addAndIgnoreNil shift 3) loglevel anyMsg)
   )

 (defn logCaller [loglevel & anyMsg ]
-  {:pre [(assumedLogLevel loglevel)]}
+  {:pre [(assumedValidLogLevel loglevel)]}
   (apply logShift 4 loglevel anyMsg)
   )

 (defn log [loglevel & anyMsg]
-  {:pre [(assumedLogLevel loglevel)]}
+  {:pre [(assumedValidLogLevel loglevel)]}
   (apply logShift 0 loglevel anyMsg)
   )


Added source-based validation tests for STB08 and STB09.

--- src/alfresco_technical_validation/source_validation.clj
+++ src/alfresco_technical_validation/source_validation.clj
@@ -53,6 +53,9 @@
                          :alf-edition    #"module\.edition=(.*)\z"
                        }
     :ant               { :ivy #"antlib:org\.apache\.ivy\.ant" }
+    :java              {
+                         :synchronized #"\ssynchronized\s"
+                       }
   })

 (defn- build-content-index-for-file-type
@@ -84,27 +87,35 @@

 (defn- module-versions
   [content-index]
-  (let [module-versions    (distinct (map #(second (first (:re-seq %))) (filter #(= :module-version (:regex-id %)) content-index)))
-        module-version-str (s/join "," module-versions)]
-    { "ModuleVersion" (if (empty? module-version-str) "Not specified" module-version-str) }))
+  (let [matches (distinct (map #(second (first (:re-seq %))) (filter #(= :module-version (:regex-id %)) content-index)))
+        message (s/join "," matches)]
+    { "ModuleVersion" (if (empty? message) "Not specified" message) }))

 (defn- alfresco-min-versions
   [content-index]
-  (let [alfresco-min-versions     (distinct (map #(second (first (:re-seq %))) (filter #(= :repo-min (:regex-id %)) content-index)))
-        alfresco-min-versions-str (s/join "," alfresco-min-versions)]
-    { "AlfrescoVersionMin" (if (empty? alfresco-min-versions-str) "Not specified" alfresco-min-versions-str) }))
+  (let [matches (distinct (map #(second (first (:re-seq %))) (filter #(= :repo-min (:regex-id %)) content-index)))
+        message (s/join "," matches)]
+    { "AlfrescoVersionMin" (if (empty? message) "Not specified" message) }))

 (defn- alfresco-max-versions
   [content-index]
-  (let [alfresco-max-versions     (distinct (map #(second (first (:re-seq %))) (filter #(= :repo-max (:regex-id %)) content-index)))
-        alfresco-max-versions-str (s/join "," alfresco-max-versions)]
-    { "AlfrescoVersionMax" (if (empty? alfresco-max-versions-str) "Not specified" alfresco-max-versions-str) }))
+  (let [matches (distinct (map #(second (first (:re-seq %))) (filter #(= :repo-max (:regex-id %)) content-index)))
+        message (s/join "," matches)]
+    { "AlfrescoVersionMax" (if (empty? message) "Not specified" message) }))

-(defn- alfresco-versions
+(defn- stb08-stb09-use-of-synchronized
   [content-index]
-  (merge
-    (alfresco-min-versions content-index)
-    (alfresco-max-versions content-index)))
+  (let [uses-of-synchronized (filter #(= :synchronized (:regex-id %)) content-index)
+        message              (str "Uses of synchronized:\n" (s/join "\n" (map #(str (:file %) " line " (:line-number %)) uses-of-synchronized)))]
+    (merge
+      (build-bookmark-map "STB08"
+                          (empty? uses-of-synchronized)
+                          (str message "\n#### Manual followup required to check these uses of synchronized. ####")
+                          "The technology does not synchronize.")
+      (build-bookmark-map "STB09"
+                          (empty? uses-of-synchronized)
+                          (str message "\n#### Manual followup required to check these uses of synchronized. ####")
+                          "The technology does not synchronize."))))

 (defn validate
   "Runs all source-based validations."
@@ -113,8 +124,10 @@
         file-index    (build-file-types-index files)
         content-index (build-content-index file-index)]
     (merge
-      (detect-build-tools file-index)
-      (module-versions    content-index)
-      (alfresco-versions  content-index)
+      (detect-build-tools              file-index)
+      (module-versions                 content-index)
+      (alfresco-min-versions           content-index)
+      (alfresco-max-versions           content-index)
+      (stb08-stb09-use-of-synchronized content-index)
     )))


Default to red idle screen

Default to red idle screen

--- src/clojure/uk/org/potentialdifference/darknet/main.clj
+++ src/clojure/uk/org/potentialdifference/darknet/main.clj
@@ -214,14 +214,23 @@
 (defn swap-view! [activity view]
   (replace-view! activity view))

+(def idle-screen
+  [:relative-layout {:layout-width :fill
+                     :layout-height :fill}
+   [:text-view {:text " °"
+                :id ::status-indicator
+                :text-size 50
+                :text-color Color/RED}]])
+
 (defn setup-video-view [view activity path]
   (doto view
     (fit-linear-layout!)
     (setVideoSource path)
-    (.setOnCompletionListener (reify
-                                MediaPlayer$OnCompletionListener
-                                (onCompletion [this mp]
-                                  (swap-view! activity (layout activity [:text-view {:text "..."}])))))
+    (.setOnCompletionListener
+     (reify
+       MediaPlayer$OnCompletionListener
+       (onCompletion [this mp]
+         (swap-view! activity (layout activity idle-screen)))))
     (.start))
   view)

@@ -231,9 +240,13 @@
 (defn save-locally! [activity instruction]
   (when-let [name (:name instruction)]
     (when-let [url (:url instruction)]
+      (log/i "darknet" "getting bytes...")
       (server/get-bytes url
                         (fn [bytes]
-                          (storage/write-bytes! bytes name))))))
+                          (log/i "darknet" "writing bytes...")
+                          (storage/write-bytes! bytes name)
+                          (on-ui
+                              (toast (str "Saved " name))))))))

 (defn view-local [activity instruction]
   (when-let [name (:name instruction)]
@@ -247,14 +260,6 @@
     (case (:type instruction)
       "image" (layout activity (image-from-url activity url))
       "video" (layout activity (video-from-path activity url)))))
-
-(def idle-screen
-  [:relative-layout {:layout-width :fill
-                     :layout-height :fill}
-   [:text-view {:text " °"
-                :id ::status-indicator
-                :text-size 50
-                :text-color Color/GREEN}]])

 (defn set-status! [context color]
   (on-ui
@@ -283,7 +288,7 @@
                                                                    (let [out (java.io.StringWriter.)]
                                                                      (pprint sizes out)
                                                                      (.toString out))}]))
-                               "stop" (sv (layout this [:text-view {:text "..."}]))
+                               "stop" (sv (layout this idle-screen))
                                :default))))
           sizes {:rear  (camera/preview-sizes 0)
                  :front (camera/preview-sizes 1)}]
@@ -307,8 +312,7 @@
                             :on-error (fn [e]
                                         (log/i "darknet on error" (.getMessage e))
                                         (set-status! this Color/RED)
-                                        (Thread/sleep 200)
-                                        (new-client))})))]
+                                        (Thread/sleep 200))})))]
           (new-client)))
       (on-ui
           (set-content-view! this


tested that forgot password works

tested that forgot password works

--- server/test/gratefulplace/controllers/credential_recovery/t_forgot_password.clj
+++ server/test/gratefulplace/controllers/credential_recovery/t_forgot_password.clj
@@ -12,5 +12,17 @@
   (dj/ent-count :user/password-reset-token)
   => 1)

-(fact "consumes token with update"
-  )+(facts "about token"
+  (res :post "/credential-recovery/forgot-password" {:username (:username (auth))})
+  (let [token (:user/password-reset-token (dj/one :user/password-reset-token))
+        path (str "/credential-recovery/forgot-password/" token)]
+    (fact "returns ok when token exists"
+      (res :get path)
+      => (contains {:status 200}))
+    (fact "returns 501 when token doesn't exist"
+      (res :get "/credential-recovery/forgot-password/xyz")
+      => (contains {:status 400}))
+    (fact "consumes token with update"
+      (res :put path {:new-password "test1234" :new-password-confirmation "test1234"})
+      (dj/ent-count :user/password-reset-token)
+      => 0)))


Add TABLE support for honeysql.

Add TABLE support for honeysql.

Required for h2 performance.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -4,6 +4,8 @@
   (:require [org.clojars.smee.binary.core :as binary])
   (:require [clojure.java.io :as io])
   (:require [honeysql.core :as hsql])
+  (:require [honeysql.format :as hsqlfmt])
+  (:require [honeysql.types :as hsqltypes])
   (:require [clojure.data.json :as json])
   (:use [cavm.binner :only (calc-bin)])
   (:use [clj-time.format :only (formatter unparse)])
@@ -989,6 +991,32 @@
   (let [[qstr & args] (hsql/format q)]
     (exec-raw [qstr args] :results)))

+;
+; add TABLE handling for honeysql
+;
+
+(defmethod hsqlfmt/format-clause :table [[_ [fields alias]] _]
+  (str "TABLE("
+       (clojure.string/join ", "
+       (map (fn [[name type values]]
+              (str (hsqlfmt/to-sql name) " " (hsqlfmt/to-sql type) "="
+                   (hsqlfmt/paren-wrap (clojure.string/join ", " (map hsqlfmt/to-sql values))))) fields))
+       ") " (hsqlfmt/to-sql alias)))
+
+; Fix GROUP_CONCAT in honeysql
+(defn- format-concat
+  ([value {:keys [order separator]}]
+   (let [oclause (if (nil? order)
+                   ""
+                   (str " order by " (hsqlfmt/to-sql order)))
+         sclause (if (nil? separator)
+                   ""
+                   (str " separator " (hsqlfmt/to-sql separator)))]
+     (str "GROUP_CONCAT(" (hsqlfmt/to-sql value) oclause sclause ")"))))
+
+(defmethod hsqlfmt/fn-handler "group_concat" [_ value & args]
+  (format-concat value args))
+
 ; XXX monkey-patch korma to work around h2 bug.
 ; h2 will fail to select an index if joins are grouped, e.g.
 ; FROM (a JOIN b) JOIN c


add docstrings

add docstrings

--- src/chartem.clj
+++ src/chartem.clj
@@ -14,17 +14,29 @@
 ;;  a match is a map with pass? and message, message will be a string
 ;;  if pass? if false

-(defn equals [a]
+(defn equals
+  "matches based on equality of the value given
+
+  (run-match (equals 1) 1) ; => passes
+  (run-match (equals 1) 2) ; => fails "
+  [a]
   {:match (fn [b] (= a b))
    :description (str "(= " (pr-str a) ")")
    :describe-mismatch (fn [b] (pr-str b))})

-(defn format-message [result]
+(defn format-message
+  "turns the results of a failing match into a human readable error message,
+   suitable for printing with clojure.core/print or clojure.core/println"
+  [result]
   (str "\nExpected: " (:expected result)
        "\n     but: "
        (:was result)))

 (defn every?
+  "matches if all of the matchers given pass:
+
+  (run-match (every? (equals 1) (equals 1)) 1) ; => passes
+  (run-match (every? (equals 1) (equals 1)) 2) ; => fails"
   [ms]
   {:match (fn [a] (reduce (fn [x y] (and x y))
                           (map #((:match %) a) ms)))
@@ -33,6 +45,18 @@
    :describe-mismatch })

 (defn run-match
+  "runs a matcher, given a value to match against.
+  Returns a map:
+
+  if the matcher matches the value:
+  {:pass? true}
+
+  if the matcher fails:
+  {:pass? false
+  :expected (a string)
+  :was (a string)}
+
+  the results can be made human readable with (format-message result)"
   [matcher a]
   (if ((:match matcher) a)
     {:pass? true}


new gist minor fix

new gist minor fix

--- src/cmd/ui.cljs
+++ src/cmd/ui.cljs
@@ -155,7 +155,9 @@

             (dom/input #js {:type "text"
                             :title "Filename"
-                            :style #js {:display "none"}
+                            :style (if (= (:mode state) :new-gist)
+                                     #js {:display "inline-block"}
+                                     #js {:display "none" :value ""})
                             :id "new-gist-name"})

             (dom/label #js {:className "ios7"} "SELECT_G!ST: ")


Removed some code generation

Removed some code generation

Undid some of the over-zealous code duplication elimination now that I'm
in a different mood

--- src/hyjinks.clj
+++ src/hyjinks.clj
@@ -17,7 +17,9 @@
 			\" """
 			\' "'"})))

-(defn- readable-string [id] (if (keyword? id) (join " " (map capitalize (split (name id) #"-"))) id))
+(defn- readable-string [id]
+	(if-not (keyword? id) id
+		(join " " (map capitalize (split (name id) #"-")))))

 (defn- $lift [& fs] (partial map #(%1 %2) fs))

@@ -48,16 +50,19 @@

 (def empty-css (Css.))

-(dorun (map (fn [sym] (eval `(def ~(symbol (lower-case (str sym "?"))) (partial instance? ~sym)))) [
-	'Literal 'Tag 'Css]))
+(def literal? (partial instance? Literal))
+
+(def tag? (partial instance? Tag))
+
+(def css? (partial instance? Css))

 (defn attrs? [x] (and (map? x) (not (css? x)) (not (tag? x)) (not (literal? x))))

 (defn child-item? [x] (not (or (attrs? x) (css? x))))

-(dorun (map (fn [sym] (let [k (keyword sym) sym (symbol (str "assoc-" sym))]
-	(eval `(defn ~sym [~'t & ~'kvs] (assoc ~'t ~k (merge (~k ~'t) (apply hash-map ~'kvs))))))) [
-		'attrs 'css]))
+(defn assoc-attrs [t & key-vals] (assoc t :attrs (merge (:attrs t) (apply hash-map key-vals))))
+
+(defn assoc-css [t & key-vals] (assoc t :css (merge (:css t) (apply hash-map key-vals))))

 (defn css [& key-vals] (merge empty-css (apply hash-map key-vals)))

@@ -66,6 +71,8 @@
 	      css (apply merge empty-css (filter css? stuff))
 	      items (flatten (filter child-item? stuff))]
 		(Tag. nm attrs css items)))
+
+(defn literal [& content] (Literal. (str-join content)))

 ;; Declaring a whole bunch of tags

@@ -81,8 +88,6 @@
 	'address 'article 'header 'footer 'main 'section 'aside 'figure 'figcaption
 	'form 'legend 'fieldset 'select 'option 'optgroup 'label 'input 'button 'progress
 	'html 'head 'title 'link 'style 'script 'base 'body 'noscript]))
-
-(defn literal [& content] (Literal. (str-join content)))

 (defn !-- [& content] (literal (str-join "<!-- " content " -->")))


[#105] Identify the registration form in the survey definition

--- api/src/clojure/org/akvo/flow_api/datastore/survey.clj
+++ api/src/clojure/org/akvo/flow_api/datastore/survey.clj
@@ -3,6 +3,7 @@
   (:require [org.akvo.flow-api.anomaly :as anomaly]
             [org.akvo.flow-api.datastore :as ds])
   (:import [com.gallatinsystems.survey.dao.SurveyDAO]
+           [com.gallatinsystems.survey.dao.SurveyGroupDAO]
            [org.akvo.flow.api.dao FolderDAO SurveyDAO]))

 (defn list [user-id folder-id]
@@ -37,15 +38,16 @@
      :created-at (ds/created-at question-group)
      :modified-at (ds/modified-at question-group)}))

-(defn get-form-definition [form-id]
+(defn get-form-definition [form-id registration-form-id]
   (let [form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
         ;; Includes question groups, but contrary to docstring does not contain questions
         form (.loadFullSurvey form-dao form-id)
         question-dao (com.gallatinsystems.survey.dao.QuestionDao.)
         questions (group-by #(.getQuestionGroupId %)
                             (.listQuestionsBySurvey question-dao form-id))]
-    {:id (str (ds/id form))
+    {:id (str form-id)
      :name (.getName form)
+     :registration-form (= form-id registration-form-id)
      :question-groups (mapv (fn [question-group]
                               (question-group-definition question-group
                                                          (get questions (ds/id question-group))))
@@ -59,6 +61,7 @@
                  survey
                  (anomaly/not-found "Survey not found"
                                     {:survey-id survey-id}))
+        registration-form-id (.getNewLocaleSurveyId survey)
         form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
         all-forms (.listSurveysByGroup form-dao (Long/parseLong survey-id))
         forms (.filterByUserAuthorizationObjectId form-dao
@@ -70,7 +73,7 @@
                              :user-id user-id})
       {:id survey-id
        :name (.getName survey)
-       :forms (mapv #(get-form-definition (ds/id %))
+       :forms (mapv #(get-form-definition (ds/id %) registration-form-id)
                     forms)
        :created-at (ds/created-at survey)
        :modified-at (ds/modified-at survey)})))


keypress events needs to actually seed

keypress events needs to actually seed

--- src/mediakeys/hotkeys.clj
+++ src/mediakeys/hotkeys.clj
@@ -62,6 +62,7 @@
             ))))

 (defcurried seed-channel! [seed channel]
+    (println "yo seedding channel")
     (put! channel seed)
     channel)

@@ -69,3 +70,8 @@
     (comp
         (seed-channel! "{}")
         (flatmap< keypress-channel!)))
+
+(defn keypress-events! [key-changes]
+    (let [result (flatmap< keypress-channel! key-changes)]
+        (seed-channel! "{}" key-changes)
+        result))


Fixed clojure-test-mode error (Slime test reports ok, but clojure-test-mode reports not ok.

--- src/midje/util/report.clj
+++ src/midje/util/report.clj
@@ -1,11 +1,16 @@
+(when (= (class clojure.test/report) clojure.lang.MultiFn)
+  (eval
+   '(do (require 'clojure.test)
+        (ns clojure.test)
+        (defonce old-report clojure.test/report))))
+
 (ns midje.util.report
     (:use clojure.test))

 (defn- midje-position-string [position-pair]
   (format "(%s:%d)" (first position-pair) (second position-pair)))

-
-(defmethod clojure.test/report :mock-argument-match-failure [m]
+(defmethod clojure.test/old-report :mock-argument-match-failure [m]
 ;  (with-test-out
    (inc-report-counter :fail)
    (println "\nFAIL at" (midje-position-string (:position m)))
@@ -13,7 +18,7 @@
    (println "You never said" (:name (meta (:function m))) "would be called with these arguments:")
    (println (pr-str (:actual m))))

-(defmethod clojure.test/report :mock-incorrect-call-count [m]
+(defmethod clojure.test/old-report :mock-incorrect-call-count [m]
 ;  (with-test-out
    (inc-report-counter :fail)
    (println "\nFAIL for" (midje-position-string (:position m)))
@@ -22,7 +27,7 @@
    (println (:expected m) "should be called at least once."))

-(defmethod clojure.test/report :mock-expected-result-failure [m]
+(defmethod clojure.test/old-report :mock-expected-result-failure [m]
 ;  (with-test-out
    (inc-report-counter :fail)
    (println "\nFAIL at" (midje-position-string (:position m)))
@@ -30,7 +35,7 @@
    (println "expected:" (pr-str (:expected m)))
    (println "  actual:" (pr-str (:actual m))))

-(defmethod clojure.test/report :mock-expected-result-functional-failure [m]
+(defmethod clojure.test/old-report :mock-expected-result-functional-failure [m]
 ;  (with-test-out
    (inc-report-counter :fail)
    (println "\nFAIL at" (midje-position-string (:position m)))


WS fix

WS fix

--- worker/src/worker/main.clj
+++ worker/src/worker/main.clj
@@ -17,39 +17,38 @@
   (.start (Thread. #(lc/subscribe channel queue-name handler-fn :auto-ack false))))

 (defn -main
-    [& args]
-
-      (let [connection (rmq/connect)
-          channel-fast (lch/open connection)
-          channel-slow (lch/open connection)]
-        (println (str "connected " (.getChannelNumber channel-fast)))
-        (lq/declare channel-fast "geocommit.job.fast" :durable true :exclusive false :auto-delete false)
-        (lq/declare channel-fast "geocommit.job.slow" :durable true :exclusive false :auto-delete false)
-        (if (= (first args) "fill")
-          (do
-            (lb/publish
-              channel-fast
-              default-exchange-name
-              "geocommit.job.fast"
-              "{\"url\": \"github.com/already/exists\"}"
-              :content-type "application/json"
-              :type "geocommit.job.update")
-            (lb/publish
-              channel-slow
-              default-exchange-name
-              "geocommit.job.slow"
-              "{\"url\": \"github.com/new/repo\"}"
-              :content-type "application/json"
-              :type "geocommit.job.init")
-            (lb/publish
-              channel-fast
-              default-exchange-name
-              "geocommit.job.fast" "{\"url\": \"github.com/new/repo\"}"
-              :content-type "application/json"
-              :type "geocommit.job.update")
-            (rmq/close channel-fast)
-            (rmq/close channel-slow)
-            (rmq/close connection))
-          (do
-            (start-consumer connection channel-fast "geocommit.job.fast" message-handler)
-            (start-consumer connection channel-slow "geocommit.job.slow" message-handler)))))
+  [& args]
+  (let [connection (rmq/connect)
+        channel-fast (lch/open connection)
+        channel-slow (lch/open connection)]
+    (println (str "connected " (.getChannelNumber channel-fast)))
+    (lq/declare channel-fast "geocommit.job.fast" :durable true :exclusive false :auto-delete false)
+    (lq/declare channel-fast "geocommit.job.slow" :durable true :exclusive false :auto-delete false)
+    (if (= (first args) "fill")
+      (do
+        (lb/publish
+          channel-fast
+          default-exchange-name
+          "geocommit.job.fast"
+          "{\"url\": \"github.com/already/exists\"}"
+          :content-type "application/json"
+          :type "geocommit.job.update")
+        (lb/publish
+          channel-slow
+          default-exchange-name
+          "geocommit.job.slow"
+          "{\"url\": \"github.com/new/repo\"}"
+          :content-type "application/json"
+          :type "geocommit.job.init")
+        (lb/publish
+          channel-fast
+          default-exchange-name
+          "geocommit.job.fast" "{\"url\": \"github.com/new/repo\"}"
+          :content-type "application/json"
+          :type "geocommit.job.update")
+        (rmq/close channel-fast)
+        (rmq/close channel-slow)
+        (rmq/close connection))
+      (do
+        (start-consumer connection channel-fast "geocommit.job.fast" message-handler)
+        (start-consumer connection channel-slow "geocommit.job.slow" message-handler)))))


Improved cursored mixin.

Improved cursored mixin.

--- frontend/uxbox/ui/mixins.cljs
+++ frontend/uxbox/ui/mixins.cljs
@@ -22,23 +22,27 @@

 (defn- cursored-did-mount
   [state]
-  (doseq [v (:rum/props state)
-          :when (satisfies? IWatchable v)]
-    (add-watch v (cursored-key state)
-               (fn [_ _ _ _]
-                 (rum/request-render (:rum/react-component state)))))
-  state)
+  (let [key (gensym "foobar")]
+    (doseq [v (:rum/props state)
+            :when (satisfies? IWatchable v)]
+      (add-watch v key
+                 (fn [_ _ _ _]
+                   (rum/request-render (:rum/react-component state)))))
+    (assoc state ::key key)))

-(defn- cursored-will-umount
+(defn- cursored-will-unmount
   [state]
-  (doseq [v (:rum/props state)
-          :when (satisfies? IWatchable v)]
-    (remove-watch v (cursored-key state)))
-  state)
+  (let [key (::key state)]
+    (doseq [v (:rum/props state)
+            :when (satisfies? IWatchable v)]
+      (remove-watch v key))
+    (dissoc state ::key)))

 (defn- cursored-transfer-state
   [old new]
-  (assoc new :rum/old-props (:rum/old-props old)))
+  (assoc new
+         :rum/old-props (:rum/old-props old)
+         ::key (::key old)))

 (defn- cursored-should-update
   [old-state new-state]
@@ -51,14 +55,13 @@
       [dom (assoc next-state :rum/old-props (deref-props (:rum/props state)))])))

 (def cursored
-  "A cursor like mixin that works with
-  the `component` sugar syntax and lenses
-  from the cats library."
-  {:did-mount cursored-did-mount
-   :will-unmount cursored-will-umount
-   :transfer-state cursored-transfer-state
+  {:transfer-state cursored-transfer-state
    :should-update cursored-should-update
    :wrap-render cursored-wrap-render})
+
+(def cursored-watch
+  {:did-mount cursored-did-mount
+   :will-unmount cursored-will-unmount})

 (defn local
   "Adds an atom to component’s state that can be used as local state.


:fire: Remove unused context handling on http sessions.

--- backend/src/uxbox/http/session.clj
+++ backend/src/uxbox/http/session.clj
@@ -53,5 +53,4 @@
                   (p/then' (fn [user-id]
                              (if user-id
                                (update data :request assoc :user user-id)
-                               data)))
-                  (vc/handle-on-context))))})
+                               data))))))})


Fix type hint.

Fix type hint.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -118,7 +118,7 @@
 (defn all-partitions-paused?
   [^KafkaConsumer consumer kpartitions]
   (let [paused (into #{}
-                     (map #(.partition ^org.apache.kafka.common.PartitionInfo %))
+                     (map #(.partition ^TopicPartition %))
                      (.paused consumer))]
     (= paused (set kpartitions))))


Don't use task ID as part of the checkpoint.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -37,15 +37,18 @@
      x)
     :none))

-(defn checkpoint-or-beginning [log consumer topic kpartition task-id]
-  (let [k (format "%s-%s-%s" task-id topic kpartition)]
+(defn checkpoint-name [group-id topic assigned-partition]
+  (format "%s-%s-%s" group-id topic assigned-partition))
+
+(defn checkpoint-or-beginning [log consumer topic kpartition group-id]
+  (let [k (checkpoint-name group-id topic kpartition)]
     (try
       (let [offset (inc (:offset (extensions/read-chunk log :chunk k)))]
         (seek-to-offset! consumer {:topic topic :partition kpartition} offset))
       (catch org.apache.zookeeper.KeeperException$NoNodeException nne
         (cp/seek-to-beginning-offset! consumer [{:topic topic :partition kpartition}])))))

-(defn seek-offset! [log consumer task-id topic kpartition task-map]
+(defn seek-offset! [log consumer group-id topic kpartition task-map]
   (if (:kafka/force-reset? task-map)
     (let [policy (:kafka/offset-reset task-map)]
       (cond (= policy :smallest)
@@ -56,7 +59,7 @@

             :else
             (throw (ex-info "Tried to seek to unknown policy" {:policy policy}))))
-    (checkpoint-or-beginning log consumer topic kpartition task-id)))
+    (checkpoint-or-beginning log consumer topic kpartition group-id)))

 (defn log-id [replica-val job-id peer-id task-id]
   (get-in replica-val [:task-slot-ids job-id task-id peer-id]))
@@ -125,7 +128,7 @@
               consumer (consumer/make-consumer consumer-config key-deserializer value-deserializer)
               _ (assign-partitions! consumer [{:topic topic :partition kpartition}])

-              _ (seek-offset! log consumer task-id topic kpartition task-map)
+              _ (seek-offset! log consumer group-id topic kpartition task-map)
               offset (cp/next-offset consumer {:topic topic :partition kpartition})

               empty-read-back-off (or (:kafka/empty-read-back-off task-map) (:kafka/empty-read-back-off defaults))


clj-kafka's new producer is synchronous by default The plugin currently depends on it being async for acking to work correctly

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -274,12 +274,12 @@
               p (some-> m :partition int)]
           (assert k-message
                   "Messages must be supplied in a map in form {:message :somevalue}, with optional :key and :partition keys.")
-          (kp/send producer (kp/record topic p k-key (serializer-fn k-message))))))
+          @(kp/send producer (kp/record topic p k-key (serializer-fn k-message))))))
     {})

   (seal-resource
     [_ {:keys [onyx.core/results]}]
-    (kp/send producer (kp/record topic (serializer-fn :done)))))
+    @(kp/send producer (kp/record topic (serializer-fn :done)))))

 (defn write-messages [pipeline-data]
   (let [task-map (:onyx.core/task-map pipeline-data)


Add color replace and remove events schemas.


testing pushing on flash.

testing pushing on flash.

--- src/ombs/view.clj
+++ src/ombs/view.clj
@@ -26,4 +26,5 @@

 (h/deftemplate user "ombs/user.html" []
   [:#user]  (h/content (sess/get :username "Anon"))
+  ;snippets, candies, zerg and you
   )


use faded opacity for text-in-progress instead of dashed stroke

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -211,7 +211,11 @@
         (dom/g nil nil)
         (apply dom/g nil (mapv (fn [l] (svg-element #{} (merge l {:strokeDasharray "5,5"
                                                                   :layer/fill "none"
-                                                                  :fillOpacity "0.25"})))
+                                                                  :style {:stroke (:subscriber-color l)}
+                                                                  :fillOpacity "0.25"}
+                                                               (when (= :layer.type/text (:layer/type l))
+                                                                 {:layer/stroke "none"
+                                                                  :style {:fill (:subscriber-color l)}}))))
                                layers))))))

 (defn svg-canvas [payload owner opts]
@@ -225,7 +229,7 @@
                                     (conj acc (assoc layer
                                                 :layer/end-x (:layer/current-x layer)
                                                 :layer/end-y (:layer/current-y layer)
-                                                :style {:stroke (:color subscriber)}
+                                                :subscriber-color (:color subscriber)
                                                 :layer/stroke (apply str "#" (take 6 id))))
                                     acc))
                                 [] (:subscribers payload))]


Extract data from mobile platform template.

--- src-cljs/frontend/components/mobile.cljs
+++ src-cljs/frontend/components/mobile.cljs
@@ -17,7 +17,7 @@
     [:div.outer-section.outer-section-condensed.wide-cta-banner
      [:section
       [:h3 "Start shipping faster, build for free using CircleCI today."]
-      (common/sign-up-cta owner "mobile")]]))
+      (common/sign-up-cta owner source)]]))

 (defrender mobile [app owner]
   (html
@@ -100,50 +100,64 @@
           "process of getting 5-star apps into the hands of your users."]]]]]
      (om/build mobile-cta "mobile")]))

+(defn platform [owner data]
+  [:div.product-page.mobile {:class (:name data)}
+   [:div.jumbotron
+    [:h1 (:headline data)]
+    (:jumbotron-content data)
+    (common/sign-up-cta owner (str "mobile/" (:name data)))]
+
+   [:div.outer-section
+    [:section.container
+     [:div.overview
+      [:h2 (:subheadline data)]
+      [:p (:explanation data)]
+      (let [doc-link (:documentation data)]
+        [:a.home-action.documentation
+         {:href (:href doc-link)}
+         (:title doc-link)])]]
+
+    [:section.container
+     [:div.overview
+      [:h2 (:features-heading data)]]]
+
+    [:section.container
+     [:div.feature-row
+      (for [feature (:features data)]
+        [:div.feature
+         (common/feature-icon (:icon feature))
+         [:h3 (:heading feature)]
+         [:p (:description feature)]])]]]
+   (om/build mobile-cta "mobile")])
+
 (defrender ios [app owner]
   (html
-    [:div.product-page.mobile.ios
-     [:div.jumbotron
-      [:h1 "iOS App Testing, Done Better"]
-      [:p
-       "Shipping your app on iOS is hard. The App Store review process is
-       long and painful. It’s important to get your app built right the first time to avoid
-       bugs and those nasty 1-star reviews. Let CircleCI help your iOS app development
-       cycle with our expertise in Continuous Integration and Continuous Delivery."
-       [:br]
-       "*In beta - "
-       [:a {:href (auth-url) :on-click (common/sign-up-cta owner "mobile/ios")} "sign up"]
-       " for the pilot program by marking your project iOS and you'll automatically be added to the beta."]
-      (common/sign-up-cta owner "mobile")]
-
-     [:div.outer-section
-      [:section.container
-       [:div.overview
-        [:h2 "More testing, fewer bugs, better iOS apps."]
-        [:p "Each time you push new code to your repo on Github for your
-            iOS app, CircleCI will automatically build and test your
-            changes. More testing leads to fewer bugs. Ship your app with
-            more confidence by continuously testing to ease the pain of the
-            App Store review process."]
-        [:a.home-action.documentation
-         {:href "/docs/ios"}
-         "iOS Documentation"]]]
-
-      [:section.container
-       [:div.overview
-        [:h2 "Everything you've come to expect from CircleCI, just on OS X."]]]
-
-      [:section.container
-       [:div.feature-row
-        [:div.feature
-         (common/feature-icon "circle")
-         [:h3 "Test your app on our dedicated iOS cloud"]
-         [:p "Running a dedicated build box is expensive and time consuming.
-             Let us manage the build environment. You build great iOS apps."]]
-        [:div.feature
-         (common/feature-icon "xcode")
-         [:h3 "Automate Testing"]
-         [:p "CircleCI supports any environment that you work in and the most
-             recent version(s) of the iOS toolchain (including XCode 6.x). You can build with
-             xcodebuild, xctool, CocoaPods, or git submodules."]]]]]
-     (om/build mobile-cta "mobile")]))
+    (platform owner {:name "ios"
+                     :headline "iOS App Testing, Done Better"
+                     :jumbotron-content [:p
+                                         "Shipping your app on iOS is hard. The App Store review process is
+                                         long and painful. It’s important to get your app built right the first time to avoid
+                                         bugs and those nasty 1-star reviews. Let CircleCI help your iOS app development
+                                         cycle with our expertise in Continuous Integration and Continuous Delivery."
+                                         [:br]
+                                         "*In beta - "
+                                         [:a {:href (auth-url) :on-click (common/sign-up-cta owner "mobile/ios")} "sign up"]
+                                         " for the pilot program by marking your project iOS and you'll automatically be added to the beta."]
+                     :subheadline "More testing, fewer bugs, better iOS apps."
+                     :explanation "Each time you push new code to your repo on Github for your
+                                  iOS app, CircleCI will automatically build and test your
+                                  changes. More testing leads to fewer bugs. Ship your app with
+                                  more confidence by continuously testing to ease the pain of the
+                                  App Store review process."
+                     :documentation {:title "iOS Documentation"
+                                     :href "/docs/ios"}
+                     :features-heading "Everything you've come to expect from CircleCI, just on OS X."
+                     :features [{:icon "circle"
+                                 :heading "Test your app on our dedicated iOS cloud"
+                                 :description "Running a dedicated build box is expensive and time consuming.
+                                              Let us manage the build environment. You build great iOS apps."}
+                                {:icon "xcode"
+                                 :heading "Automate Testing"
+                                 :description "CircleCI supports any environment that you work in and the most
+                                              recent version(s) of the iOS toolchain (including XCode 6.x). You can build with
+                                              xcodebuild, xctool, CocoaPods, or git submodules."}]})))


Inverse function generator for monotone increasing functions

--- src/paulkrake/predict.clj
+++ src/paulkrake/predict.clj
@@ -114,4 +114,22 @@
                                     score-to-value-fn)) x)
         (map (fn [[h g [hmin hmax] [gmin gmax]]]
                (format "%24s - %24s   [%.2f - %.2f] : [%.2f - %.2f]"
-                       h g hmin hmax gmin gmax)) x)))
+                       h g (float hmin) (float hmax) (float gmin) (float gmax))) x)))
+
+
+
+(defn inverse-fn
+  "Returns the inverse function of a monotone increasing function f"
+  [f]
+  (fn [y]
+    (let [x_min (->> (range) (filter (fn [x] (< (f (* -1 x)) y))) (first))
+          x_max (->> (range) (filter (fn [x] (>= (f x) y))) (first))]
+      (loop [a x_min
+             b x_max]
+        ;(println (format "a=%s b=%s" a b))
+        (let [mid (/ (+ a b) 2.0)]
+          (if (< (- b a) 0.000001)
+            a
+            (recur
+             (if (>= (f mid) y) a mid)
+             (if (>= (f mid) y) mid b))))))))


send an email when a vcproj file is missing

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -157,9 +157,14 @@
         javac-errs (javac-errors result-txt)
         outdated-jars (map #(.getName %)
                            (old-jars (File. micromanager "Install_AllPlatforms") 24))
-        installer-ok (exe-on-server? bits today-token)]
-    (when-not (and (empty? vs-error-text) (empty? outdated-dlls) (not test)
-                   (empty? javac-errs) (empty? outdated-jars)
+        installer-ok (exe-on-server? bits today-token)
+        missing-vcproj-files (missing-vcproj)]
+    (when-not (and (not test)
+                   (empty? vs-error-text)
+                   (empty? outdated-dlls)
+                   (empty? javac-errs)
+                   (empty? outdated-jars)
+                   (empty? missing-vcproj-files)
                    installer-ok)
       (str
         "\n\nMICROMANAGER " bits "-bit "
@@ -176,7 +181,7 @@
         (when (= 32 bits)
           (str
             (report-segment "Missing device pages" (missing-device-pages))
-            (report-segment "Missing .vcproj files" (missing-vcproj))))
+            (report-segment "Missing .vcproj files" missing-vcproj-files)))
       ))))

 (defn make-full-report [mode send?]


Document security fns. Allow config map.

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -235,11 +235,12 @@
 ;;;; Session management
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-
-
-(defn security-options
-  "TODO"
-  ([ssl-context] (security-options ssl-context nil))
+(defn make-security-options
+  "Given an SSLContext object and, optionally, a configuration map
+  describing cipher suites and/or protocols to enable, returns a
+  MarkLogic SecurityOptions object configured accordingly, to be used
+  in session or content source creation."
+  ([ssl-context] (make-security-options ssl-context nil))
   ([ssl-context {:keys [protocols cipher-suites]}]
    (let [sec-opts (SecurityOptions. ssl-context)]
      (when (seq protocols)
@@ -248,20 +249,32 @@
        (.setEnabledCipherSuites sec-opts (into-array String cipher-suites)))
      sec-opts)))

-
 (defn uri-content-source
-  "TODO"
+  "Return a ContentSource object according to the given `uri` and,
+  optionally, a configuration map describing a SecurityOptions object,
+  default Logger object, and boolean flag for whether basic
+  authentication should be attempted preemptively. Accepts URI or
+  string for `uri`."
   ([uri] (uri-content-source uri nil))
-  ;; Return a ContentSource object that will serve as the source of
-  ;; connections to the server specified by the given URI.
-  ([uri security-opts]
-   ;; TODO enforce or construct SecurityOptions for security-opts
-   (ContentSourceFactory/newContentSource (if (instance? URI uri)
-                                            uri (URI. uri))
-                                          security-opts)))
-
+  ([uri {:keys [security-options default-logger preemptive-auth]}]
+   (let [cs (if (instance? SecurityOptions security-options)
+              (ContentSourceFactory/newContentSource (if (instance? URI uri)
+                                                       uri (URI. uri))
+                                                     security-options)
+              (ContentSourceFactory/newContentSource (if (instance? URI uri)
+                                                       uri (URI. uri))))]
+     (when (instance? Logger default-logger)
+       (.setDefaultLogger cs default-logger))
+     (when (or (true? preemptive-auth)
+               (false? preemptive-auth))
+       (.setAuthenticationPreemptive cs preemptive-auth))
+     cs)))
+
+;; FIXME TODO all of these need to allow config map of :preemptive-auth, :default-logger
 (defn hosted-content-source
-  "TODO"
+  "Returna a ContentSource object according to the given `host`
+  String, integer `port`, and optionally `user` and `password`, and
+  `content-base`, and `security-options`."
   ([host port]
    ;; Return a ContentSource object that will serve as the source of
    ;; connections to the server on the given host and port, with no
@@ -275,13 +288,14 @@
   ;; Return a ContentSource object that will serve as the source of
   ;; connections to the server on the given host and port, with login
   ;; credentials of the given user and password.
-  ([host port user password content-base security-opts]
+  ([host port user password content-base security-options]
    ;; TODO enforce or construct SecurityOptions for security-opts
    (ContentSourceFactory/newContentSource host port
                                           user password
                                           content-base
-                                          security-opts)))
-
+                                          security-options)))
+
+;; FIXME TODO all of these need to allow config map of :preemptive-auth, :default-logger
 (defn managed-content-source
   "TODO"
   [cxn-provider user password content-base]
@@ -294,9 +308,6 @@
   (ContentSourceFactory/newContentSource cxn-provider
                                          user password
                                          content-base))
-
-
-

 (defn- create-session*
   "Creates session, given map of database info. If complex connection


Add pbr as alias to pushback-reader. Best name ever.

--- src/useful/io.clj
+++ src/useful/io.clj
@@ -1,5 +1,6 @@
 (ns useful.io
-  (:use [clojure.java.io :only [reader]])
+  (:use [clojure.java.io :only [reader]]
+        [useful.ns :only [defalias]])
   (:import (java.io Reader PushbackReader)))

 (defprotocol PushbackFactory
@@ -18,6 +19,8 @@
   (pushback-reader [this]
     (pushback-reader (reader this))))

+(defalias pbr pushback-reader)
+
 (let [sentinel (Object.)
       valid? #(not (identical? % sentinel))]
   (defn read-seq


not the correct abstraction

not the correct abstraction

--- cljx/plongeur-cljs/src/plongeur/activity.cljs
+++ cljx/plongeur-cljs/src/plongeur/activity.cljs
@@ -1,32 +0,0 @@
-(ns plongeur.activity
-  "OMG, we're got an Android concept here, run for yer lives!"
-  (:require [cljs.core.async :as a :refer [<! >! timeout alts! tap chan pipe close!]])
-  (:require-macros [cljs.core.async.macros :refer [go go-loop]]))
-
-(defn nav! [url] (set! (.-location js/window) url))
-
-(defn ->browse-scenes
-  "Navigate to the scene browser page."
-  [{:keys [post-request] :as cmd-chans}]
-  ;; TODO request list of scenes
-
-  (nav! "#/browse"))
-
-(defn ->create-scene
-  "Navigate to the scene creation page."
-  [{:keys [post-request] :as cmd-chans}]
-  ;; TODO request list of data files
-
-  (nav! "#/create"))
-
-(defn ->edit-scene
-  "Navigate to the scene analysis page."
-  [{:keys [post-request] :as cmd-chans} scene-id]
-  ;; TODO request scene with id
-
-  (nav! "#/scene"))
-
-(defn ->edit-config
-  "Navigate to the application configuration page."
-  []
-  (nav! "#/config"))


Layout manager #41

Layout manager #41

--- flatguicore/test/flatgui/layout_test.clj
+++ flatguicore/test/flatgui/layout_test.clj
@@ -193,6 +193,21 @@
                      {:element :f :min (m/defpoint 0.1 0.1) :pref (m/defpoint 0.2 0.1) :stch-weight 0.0 :flags nil}))
         actual (layout/assoc-constraints main cfg \- + max)]
     (test/is (= expected (map num->double actual)))))
+
+(test/deftest assoc-constraints-test8
+  (let [cfg [[:a :b]
+             [:a :c]]
+        main test-component-1
+        expected (list
+                   (list
+                     {:element :a :min (m/defpoint 0.1 0.1) :pref (m/defpoint 0.2 0.1) :stch-weight 0.0 :flags nil}
+                     {:element :b :min (m/defpoint 0.1 0.1) :pref (m/defpoint 0.2 0.1) :stch-weight 0.0 :flags nil})
+                   (list
+                     {:element :a :min (m/defpoint 0.1 0.1) :pref (m/defpoint 0.2 0.1) :stch-weight 0.0 :flags nil}
+                     {:element :c :min (m/defpoint 0.1 0.1) :pref (m/defpoint 0.3 0.1) :stch-weight 0.0 :flags nil}))
+        actual (layout/assoc-constraints main cfg \- + max)]
+    (test/is (= expected (map num->double actual)))))
+

 ;;; compute-x-dir


Allow create-dataset to take options.

Allow create-dataset to take options.

--- project/analyze-data/src/analyze_data/core.clj
+++ project/analyze-data/src/analyze_data/core.clj
@@ -7,10 +7,16 @@
             [analyze-data.score-model :refer [accuracy f1-score]]
             [analyze-data.serialize :refer [read-object]]))

+;TODO: make nice command-line wrapper
+
 (defn create-dataset
-  [f]
+  [f & options]
   (m/set-current-implementation :vectorz)
-  (create-dataset-file! :tf-idf f (string/replace f #"\.\w+$" ".dataset")))
+  (apply create-dataset-file!
+         :tf-idf
+         f
+         (string/replace f #"\.csv$" ".dataset")
+         options))

 (defn- get-options
   [model-type]


Simplify the construction of param-pairs.

--- src/poky/kv/jdbc/util.clj
+++ src/poky/kv/jdbc/util.clj
@@ -139,7 +139,7 @@
   "Returns tuple of [cond-sql cond-params] for conditions
   cond-sql is a string representation of PG array for sproc's 3rd argument"
   [conds]
-  (let [param-pairs (map #(apply pg-mget-param %) (repeat (count conds) (list \? \?)))
+  (let [param-pairs  (repeat  (count conds)  (pg-mget-param \? \?))
         value-pairs (map (juxt :key :modified_at) conds)]
     [param-pairs value-pairs]))


Make MapDependencyGraph a record for easier printing

--- src/main/clojure/clojure/tools/namespace/dependency.clj
+++ src/main/clojure/clojure/tools/namespace/dependency.clj
@@ -47,7 +47,7 @@

 (def set-conj (fnil conj #{}))

-(deftype MapDependencyGraph [dependencies dependents]
+(defrecord MapDependencyGraph [dependencies dependents]
   DependencyGraph
   (immediate-dependencies [graph key]
     (get dependencies key #{}))


Using when-not

Using when-not

--- src/background/relevance/background.cljs
+++ src/background/relevance/background.cljs
@@ -389,7 +389,7 @@
       (if replacing?
         (do
           (dispatch [:handle-deactivation active-tab])
-          (when (not is-none?)
+          (when-not is-none?
             (alarms/clear window-alarm)
             (go (dispatch [:handle-activation
                            (first (<! (tabs/query {:active true :windowId windowId})))])))


Fix reminders link.

Fix reminders link.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -82,7 +82,8 @@
         "GET"
         (str config/reminder-server-url
              "/orgs/"
-             (:uuid org))
+             (:uuid org)
+             "/reminders")
         nil))
     org))


Do not add follow-ups links when the user is logged in with the id-token only.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -94,21 +94,25 @@
         {:accept mt/reminders-list-media-type}))
     org))

-(defn- follow-ups-link [org]
-  (update-in org [:links] conj
-    (hateoas/link-map
-      "follow-ups"
-      hateoas/GET
-      (str (url org) "/follow-ups")
-      {:accept mt/entry-collection-media-type})))
+(defn- follow-ups-link [org access-level user]
+  (if (and (not (:id-token user)) (or (= access-level :author) (= access-level :viewer)))
+    (update-in org [:links] conj
+      (hateoas/link-map
+        "follow-ups"
+        hateoas/GET
+        (str (url org) "/follow-ups")
+        {:accept mt/entry-collection-media-type}))
+    org))

-(defn- follow-ups-recent-activity-link [org]
-  (update-in org [:links] conj
-    (hateoas/link-map
-      "follow-ups-activity"
-      hateoas/GET
-      (str (url org) "/follow-ups?sort=activity")
-      {:accept mt/entry-collection-media-type})))
+(defn- follow-ups-recent-activity-link [org access-level user]
+  (if (and (not (:id-token user)) (or (= access-level :author) (= access-level :viewer)))
+    (update-in org [:links] conj
+      (hateoas/link-map
+        "follow-ups-activity"
+        hateoas/GET
+        (str (url org) "/follow-ups?sort=activity")
+        {:accept mt/entry-collection-media-type}))
+    org))

 (defn- org-links [org access-level user sample-content?]
   (let [links [(self-link org)]
@@ -151,8 +155,8 @@
         (notify-link access-level user)
         (interactions-link access-level user)
         (reminders-link access-level user)
-        (follow-ups-link)
-        (follow-ups-recent-activity-link)
+        (follow-ups-link access-level user)
+        (follow-ups-recent-activity-link access-level user)
         (select-keys (conj rep-props :links)))
       {:pretty config/pretty?})))


Better workflow element error.

Better workflow element error.

--- src/onyx/static/helpful_job_errors.clj
+++ src/onyx/static/helpful_job_errors.clj
@@ -687,7 +687,7 @@
         context (get-in job (take n-deep (:path error-data)))
         match-f (match-map-or-val error-data)
         msgs (predicate-error-msg entry (assoc error-data :error-value (get-in job (:path error-data))))
-        error-f (display-err-map-or-val msgs)]
+        error-f (display-err-map-or-val [(join " " (into ["Workflow element must be"] msgs))])]
     (show-header :workflow faulty-key)
     (show-value context (dec (- path-len n-deep)) match-f error-f)
     (show-footer)))


added pretty print to distillery.core

added pretty print to distillery.core


Add minimal working notes route

Add minimal working notes route


removing core.clj

removing core.clj

--- src/ziad/core.clj
+++ src/ziad/core.clj
@@ -1,6 +0,0 @@
-(ns ziad.core)
-
-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))


Display revolverhuset.no/kaffi as url for slack msgs

--- src/clj/mokkameister/resources/slack.clj
+++ src/clj/mokkameister/resources/slack.clj
@@ -16,7 +16,7 @@
    4 "Femte gong? "})

 (def ^:private mokkameister-link
-  "<https://revolverhuset.no/kaffi/|Mokkameister>")
+  "<https://revolverhuset.no/kaffi/|revolverhuset.no/kaffi>")

 (defn- coffee-message-starting [{:keys [slack-user brew-time]} today-count]
   (format "God nyhendnad folket! %s%s starta nett traktaren, kaffi om %d minuttar!"


Slightly alter the selected-item style

Slightly alter the selected-item style

--- src/cljs/dato/debug/components/core.cljs
+++ src/cljs/dato/debug/components/core.cljs
@@ -153,6 +153,7 @@
                           :height   "50%"}
     [:.dato-debugger {:background-color "#eee"
                       :height "100%"}
+     [:.selected-item {:font-weight "bolder"}]
      [:.dato-selector {:cursor "pointer"}]
      [:.debugger-head
       [:button {:border-width  (px 1)
@@ -379,13 +380,11 @@
                                (dom/ul
                                 {:className "query-listing"}
                                 (for [[idx query] (map-indexed vector (:query l-state))
-                                      :let [current-query? (= (:title query) (:current-query l-state))
+                                      :let [current-query? (= idx (:current-query l-state))
                                             title (str idx ". " (:title query))]]
-                                  (dom/li {:className "dato-selector"
+                                  (dom/li {:className (str "dato-selector " (when current-query? "selected-item"))
                                            :on-click #(om/set-state! owner [:current-query] idx)}
-                                          (if current-query?
-                                            (dom/strong title)
-                                            title))))))
+                                          title)))))
                  :editor     (dom/div
                               "Code editor"
                               (dom/link {:rel      "stylesheet"


check for keypress

check for keypress

--- src/cljs/infinitelives/utils/events.cljs
+++ src/cljs/infinitelives/utils/events.cljs
@@ -7,11 +7,15 @@
    [cljs.core.async.macros :refer [go]])
   )

+;; a dynamic var that passes through ctrl+shift+key events
+;; to the root event handler
+(defonce ^:dynamic *devtools-passthrough* true)
+
 ;;
 ;; an atom which holds the present state of a key
 ;; true meaning pressed, and false or nil meaning raised
 ;;
-(def !key-state (atom {}))
+(def key-state (atom {}))

 (defn ascii
   "A clojurescript version of ascii value of. javascript doesn't have
@@ -122,3 +126,29 @@
   []
   (.addEventListener js/window "keydown" handle-keydown-event)
   (.addEventListener js/window "keyup" handle-keyup-event))
+
+(defn is-pressed?
+  "returns true if the key is pressently down. code is a keyword,
+  or a string of length 1. Examples:
+
+  ```
+  ;; test if keys are down by keyword
+  (is-pressed? :backspace)
+  (is-pressed? :f10)
+  (is-pressed? :left)
+  (is-pressed? :space)
+  (is-pressed? :w)
+  (is-pressed? :a)
+
+  ;; test if keys are down by string
+  (is-pressed? \" \")
+  (is-pressed? \"w\")
+  (is-pressed? \"a\")
+  (is-pressed? \"d\")
+  (is-pressed? \"s\")
+  ```
+
+  See key-codes for a list of keyword keys.
+"
+  [code]
+  (@key-state (key-codes code)))


remove duplicate registration of search-input-entered-handler

--- src/cljs/phonecat_re_frame/handlers.cljs
+++ src/cljs/phonecat_re_frame/handlers.cljs
@@ -79,10 +79,6 @@
   [app-state [_ search-input]]
   (assoc-in app-state [:search-input] search-input))

-(register-handler
-  :search-input-entered
-  handle-search-input-entered)
-
 (defn handle-order-prop-changed
   [app-state [_ order-prop]]
   (assoc-in app-state [:order-prop] order-prop))


removing comment of all other POCs

removing comment of all other POCs

--- src/clojure/my/company/superapp/main.clj
+++ src/clojure/my/company/superapp/main.clj
@@ -283,18 +283,11 @@
                                      :tab-listener (tab-listener
                                                     :on-tab-selected (fn [tab ft]
                                                                        (toast "Settings was presed")))}]]})
+
+    ;; Start main service the will use for httpd ...
     (log/i "MOCO starting main-service...")
     (service/start-service-unbound (*a) stest/main-service-name)
-    (comment
-    ;; manually invoke the main service
-
-    ;; (def i (intent/intent (*a) 'my.company.superapp.SecService {}))
-    ;; (def s (intent/intent (*a) 'my.company.superapp.MainService {}))
-    ;; using activity contex method...
-    ;; (.startService (*a) i)
-    ;; (.startService (*a) s)
-    ;; Using service macro
-    ;; (service/start-service-unbound (*a) "my.company.superapp.SecService")
+
     ;; setup the couchbase database
     (log/i "creating manager")
     ;; should change (*a) "this" in production, this is easy for REPL
@@ -440,7 +433,7 @@
     (toast "starting HTTPD-WSD servers" :long)
     (start-servers httpd-wsd)
     (def route ["/index.html" :index])
-    (log/i (bidi/match-route route "/index.html")))
+    (log/i (bidi/match-route route "/index.html"))
     (neko.debug/keep-screen-on this)
     (on-ui
       (set-content-view! (*a)


add log settable log level per package

add log settable log level per package

--- src/clojure/zensols/actioncli/log4j2.clj
+++ src/clojure/zensols/actioncli/log4j2.clj
@@ -17,27 +17,29 @@
   "Default log level for [[log-level-set-option]]."
   (Level/toLevel "info"))

+(defn- to-level [level-thing]
+  (if (string? level-thing)
+    (Level/toLevel level-thing)
+    level-thing))
+
 (defn change-log-level
   "Change the Log4j2 log level.

   **level-thing** the log level as either the Level instance or a string."
-  [level-thing]
-  (log/debugf "new log level: %s" level-thing)
-  (let [level (if (string? level-thing)
-                (Level/toLevel level-thing)
-                level-thing)]
-    (LogUtil/setAllLevel level)))
+  ([log-name level-thing]
+   (log/debugf "new log level: %s -> %s" log-name level-thing)
+   (LogUtil/setLevel log-name (to-level level-thing)))
+  ([level-thing]
+   (log/debugf "new log level: %s" level-thing)
+   (LogUtil/setAllLevel (to-level level-thing))))

 (defn configure
-  "Congigure the Log4j2 system with an XML resource."
-  [xml-resource]
-  (let [res (io/resource xml-resource)]
-    (if (nil? res)
-      (throw (ex-info (format "No such resource: %s" xml-resource)
-                      {:xml-resource xml-resource})))
-    (with-open [in (io/input-stream res)]
-      (LogUtil/config in))
-    (log/debugf "configured with XML resource: %s" xml-resource)))
+  "Congigure the Log4j2 system with **res**, which can be anything usable
+  with [[clojure.java.io/input-stream]]."
+  [res]
+  (with-open [in (io/input-stream res)]
+    (LogUtil/config in))
+  (log/debugf "configured with XML resource: %s" res))

 (defn log-level-set-option
   "Create an option that sets the Log4j2 level.  Note that all you need to do