Fix a ton of problems with builds from the DB

- it didn't split on some kinds of newlines
- it didn't use inferred when tests weren't specified
- it didn't set the test type

--- src/circle/backend/build/config.clj
+++ src/circle/backend/build/config.clj
@@ -65,30 +65,49 @@

 (defn parse-spec-actions [spec]
   (->> spec
-       (#(select-keys % [:setup :dependencies :compile :test :extra]))
+       (#(select-keys % [:setup :dependencies :test :extra]))
        (map-vals (fn [lines]
                    (->> lines
                         (re-seq #".*")
                         (vec)
                         (remove empty?)
                         (map parse-action))))))
-
-(defn spec-commands [spec]
-  (->> spec
-       ((juxt :setup :dependencies :compile :test :extra))
-       (mapcat (fn [line]
-                 (str/split (or line "") #"\r\n")))
-       (remove empty?)))
-
+(defn set-spec [actions]
+  (map #(action/set-source % :spec) actions))
+
+(defn set-type [actions type]
+  (map #(action/set-type % type) actions))
+
+(defn get-db-config [project inferred]
+  (let [spec (parse-spec-actions project)
+        pre-setup (-> spec :setup) ;; legacy db field names :(
+        pre-setup (-> pre-setup set-spec (set-type :pre-setup))
+
+        ;; Inferred if not in the DB
+        setup (-> spec :dependencies) ;; legacy db field names :(
+        setup (-> setup set-spec (set-type :setup))
+        inferred-setup (->> inferred :actions (filter #(= :setup (:type %))))
+        setup (if (= () setup) inferred-setup setup)
+
+        ;; Inferred if not in the DB
+        test (-> spec :test)
+        test (-> test set-spec (set-type :test))
+        inferred-test (->> inferred :actions (filter #(= :test (:type %))))
+        test (if (= () test) inferred-test test)
+
+        extra (-> spec :extra)
+        extra (-> extra set-spec (set-type :post-test))
+
+        actions (concat pre-setup setup test extra)
+        actions (template/apply-template :build actions)]
+    {:job-name :build
+     :actions actions}))

 (defn validate-job [job]
   (validate! [(require-keys [:template])] job))

 (defn parse-actions [commands]
   (doall (map parse-action commands)))
-
-(defn set-spec [actions]
-  (map #(action/set-source % :spec) actions))

 (defn load-actions
   "Finds job in config, loads approprate template and parses actions"
@@ -179,12 +198,6 @@
       (git/checkout repo vcs-revision))))

-(defn get-db-config [project]
-  (when-let [spec (spec/get-spec-for-project project)]
-    (when-let [commands (seq (spec-commands spec))]
-      {:job-name :build
-       :actions (load-actions commands :build)})))
-
 (defn read-yml-config [repo]
   (-> repo
       (fs/join "circle.yml")
@@ -216,9 +229,9 @@
         commit-details (git/commit-details repo vcs-revision)
         project (project/get-by-url! url)

-        db-config (get-db-config project)
-        yml-config (get-yml-config repo)
         inferred-config (infer-config repo)
+        db-config (get-db-config project inferred-config)
+        yml-config (get-yml-config repo :job-name job-name)

         proto-build (cond
                      infer inferred-config


remove some logging statements

remove some logging statements

--- src/cljs/websocket_client/core.cljs
+++ src/cljs/websocket_client/core.cljs
@@ -27,8 +27,8 @@

     impl/WritePort
     (put! [aws val fn-handler]
-      (log "in put! protocol implementation")
-      (log "aws: >> " (keys aws) " <<")
+      ;; (log "in put! protocol implementation")
+      ;; (log "aws: >> " (keys aws) " <<")
       (impl/put! (:app-send-chan aws) val fn-handler)))

 (defn async-websocket [ws-url]
@@ -42,7 +42,7 @@
   (fn []
     (go
       (loop []
-        (log "Wait for messages on [ws-only-send-chan].")
+        ;; (log "Wait for messages on [ws-only-send-chan].")
         ;; (log "ws-only-send-chan: >> " (:ws-only-send-chan aws) " <<" )
         (let [msg (<! (:ws-only-send-chan aws))]
           ;; (log "Popped message, off websocket only send channel: >> " msg " <<")


allow reduction for decomposing equality ?

--- src/latte/equal.clj
+++ src/latte/equal.clj
@@ -24,13 +24,17 @@
                         (= (count t) 4)
                         (= (first t) #'latte.equal/equal))
     [:ok (second t) (nth t 2) (nth t 3)]
-    (let [[t ok?] (latte.kernel.norm/delta-step def-env t)]
+    (let [[t ok?] (norm/delta-step def-env t)]
+      (println "[decompose-equal-type] delta-term=" t " (reduced ? " ok? ")")
       (if ok?
         (recur def-env ctx t)
-        ;; XXX: cannot decompose further becayse
-        ;; we cannot retrieve the x and y of the
-        ;; definition ... needs a form of unification.
-        [:ko nil nil nil]))))
+        (let [[t ok?] (norm/beta-step t)]
+          (if ok?
+            (recur def-env ctx t)
+            ;; XXX: cannot decompose further because
+            ;; we cannot retrieve the x and y of the
+            ;; definition ... needs a form of unification.
+            [:ko nil nil nil]))))))

 (defthm eq-refl
   "The reflexivity property of equality."


as with English, consolidate grammar rules and use a default-fn instead

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -25,6 +25,41 @@
    [clojure.repl :refer (doc)]
    [dag_unify.core :refer (fail? get-in remove-matching-keys strip-refs unify)]))

+(defn default-fn [tree]
+  (let [result
+        (-> tree
+
+            (apply-default-if
+             verb-default?
+             {:synsem {:aux false
+                       :cat :verb
+                       :sem {:tense :conditional}
+                       :infl :conditional}})
+
+            (apply-default-if
+             verb-default?
+             {:synsem {:aux false
+                       :cat :verb
+                       :sem {:tense :present
+                             :aspect :simple}
+                       :infl :present}})
+
+            (apply-default-if
+             verb-default?
+             {:synsem {:aux false
+                       :cat :verb
+                       :sem {:tense :past
+                             :aspect :progressive}
+                       :infl :imperfetto}})
+
+            (apply-default-if
+             verb-default?
+             {:synsem {:aux false
+                       :cat :verb
+                       :sem {:tense :future}
+                       :infl :future}}))]
+    [result]))
+
 (declare model)

 (defonce index-lexicon-on-paths
@@ -34,6 +69,7 @@
    [:synsem :essere]
    [:synsem :infl]
    [:synsem :sem :pred]])
+

 (defonce tenses
   {"conditional" {:synsem {:sem {:tense :conditional}}}
@@ -350,25 +386,9 @@
                                         :cat :verb
                                         :sem {:tense :future}}})
                        (unify c10
-                              root-is-head
-                              {:rule "s-future-nonphrasal"
-                               :head {:phrasal false}
-                               :synsem {:aux false
-                                        :infl :future
-                                        :cat :verb
-                                        :sem {:tense :future}}})
-                       (unify c10
                               root-is-head-root
                               {:rule "s-conditional-phrasal"
                                :head {:phrasal true}
-                               :synsem {:aux false
-                                        :infl :conditional
-                                        :cat :verb
-                                        :sem {:tense :conditional}}})
-                       (unify c10
-                              root-is-head
-                              {:rule "s-conditional-nonphrasal"
-                               :head {:phrasal false}
                                :synsem {:aux false
                                         :infl :conditional
                                         :cat :verb
@@ -382,24 +402,13 @@
                                         :cat :verb
                                         :sem {:aspect :progressive
                                               :tense :past}}})
+
                        (unify c10
                               root-is-head
-                              {:rule "s-imperfetto-nonphrasal"
+                              {:rule "sentence-nonphrasal-head"
                                :head {:phrasal false}
-                               :synsem {:aux false
-                                        :infl :imperfetto
-                                        :cat :verb
-                                        :sem {:aspect :progressive
-                                              :tense :past}}})
-                       (unify c10
-                              root-is-head
-                              {:rule "s-present-nonphrasal"
-                               :head {:phrasal false}
-                               :synsem {:aux false
-                                        :infl :present
-                                        :cat :verb
-                                        :sem {:aspect :simple
-                                              :tense :present}}})
+                               :synsem {:cat :verb}})
+
                        (unify c10
                               root-is-head-root
                               {:rule "s-present-phrasal"
@@ -442,7 +451,7 @@
                                :comp {:phrasal false}
                                :synsem {:aux true
                                         :cat :verb}})
-
+
                        ;; this rule is kind of complicated and made more so by
                        ;; dependence on auxilary sense of "avere" which supplies the
                        ;; obj-agr agreement between the object and the main (non-auxilary) verb.
@@ -493,7 +502,7 @@

                        ;;{:root {:italiano {:italiano "abbracciare"}}, :synsem {:cat :verb, :subcat [], :sem {:aspect :perfect, :tense :present :obj :unspec}}}
                        ;; (take 5 (repeatedly #(println ((:morph-ps model) (babel.generate/generate spec model)))))
-
+
                        (unify h21
                               root-is-head
                               {:rule "vp-past"
@@ -506,7 +515,7 @@
                                         :infl :passato
                                         :cat :verb}}
                               vp-non-pronoun)
-
+
                        (unify h21
                               root-is-head
                               {:rule "vp-present"
@@ -516,7 +525,7 @@
                                               :aspect :simple}
                                         :cat :verb}}
                               vp-non-pronoun)
-
+
                        (unify c21
                               root-is-head-root
                               {:head {:phrasal true}
@@ -593,17 +602,17 @@
 (defn aux-is-head-feature [phrase]
   (cond (= :verb (get-in phrase '(:synsem :cat)))
         (unify phrase
-                (let [ref (atom :top)]
-                  {:synsem {:aux ref}
-                   :head {:synsem {:aux ref}}}))
+               (let [ref (atom :top)]
+                 {:synsem {:aux ref}
+                  :head {:synsem {:aux ref}}}))
         true phrase))

 (defn modal-is-head-feature [phrase]
   (cond (= :verb (get-in phrase '(:synsem :cat)))
         (unify phrase
-                (let [ref (atom :top)]
-                  {:synsem {:modal ref}
-                   :head {:synsem {:modal ref}}}))
+               (let [ref (atom :top)]
+                 {:synsem {:modal ref}
+                  :head {:synsem {:modal ref}}}))
         true phrase))

 ;; TODO: warn about failures.
@@ -720,6 +729,7 @@
       :name (str
              "Italiano language model created with ❤ by babel.italiano.grammar/model-plus-lexicon "
              "at: " (local-timestamp))
+      :default-fn default-fn
       :grammar grammar
       :language "it"
       :language-keyword :italiano


turn down logging

turn down logging

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -708,8 +708,8 @@
 (defn model-plus-lexicon
   "create a language model for Italian with the supplied lexicon."
   [lexicon & [grammar-filter-rule]]
-  (let [debug (log/info "  loading lexicon..")
-        debug (log/info "  filtering lexicon..")
+  (let [debug (log/debug "  loading lexicon..")
+        debug (log/debug "  filtering lexicon..")
         lexicon
         (into {}
               (for [[k vals] lexicon]
@@ -719,7 +719,7 @@
                   (if (not (empty? filtered-vals))
                     [k filtered-vals]))))

-        debug (log/info "  lexicon for generation..")
+        debug (log/debug "  lexicon for generation..")
         lexicon-for-generation (lexicon-for-generation lexicon)

         grammar-filter-rule
@@ -731,9 +731,9 @@
         rules (map #(keyword (get-in % [:rule])) grammar)

         ;; indices from paths to subsets of the lexicon
-        debug (log/info "  indices..")
+        debug (log/debug "  indices..")
         indices (create-indices lexicon-for-generation index-lexicon-on-paths)
-        debug (log/info "  finalizing..")]
+        debug (log/debug "  finalizing..")]

     (->
      ;; Create the model in stages. We need to do this because some closures need a model


connections page

connections page

--- cljx/plongeur-clj/src/kierros/sente_server_driver.clj
+++ cljx/plongeur-clj/src/kierros/sente_server_driver.clj
@@ -17,8 +17,12 @@

 (defn connections-page
   [connected-uids]
-  (warn connected-uids)
-  (html [:h1 "Connected UIDs:" (str connected-uids)]))
+  (html [:h1 "Connected UIDs:"
+         (for [[key id-set] connected-uids]
+           (list [:h2 key]
+                 [:ul]
+                 (for [id id-set]
+                   [:li id])))]))

 (defn make-sente-server-driver
   "Accepts an options map.


Add Subject Sex Enums

Add Subject Sex Enums

--- src/lens/schema.clj
+++ src/lens/schema.clj
@@ -35,6 +35,10 @@
      :db/valueType :db.type/ref
      :db/cardinality :db.cardinality/one
      :db/doc "The sex of a subject."}]
+
+   :enums
+   [:subject.sex/male
+    :subject.sex/female]

    :functions
    [(func :add-subject
@@ -405,7 +409,7 @@
       (assoc :db.install/_attribute :db.part/db)))

 (defn make-enum
-  "Assocs :db/id to the enum map."
+  "Assocs :db/id to the enum."
   [enum]
   (assoc-tempid {:db/ident enum} :db.part/user))

@@ -417,9 +421,10 @@
 (defn prepare-schema [schema]
   (-> (mapv make-part (concat (:partitions subject)
                               (:partitions schema)))
-      (into (mapv make-attr (concat (:attributes subject)
+      (into (map make-attr (concat (:attributes subject)
                                     (:attributes schema))))
-      (into (mapv make-func (:functions subject)))
+      (into (map make-enum (:enums subject)))
+      (into (map make-func (:functions subject)))
       (into (:functions schema))))

 (defn load-base-schema


fix samples example

fix samples example

--- examples/samples.clj
+++ examples/samples.clj
@@ -21,7 +21,7 @@

 ; Now the audio data for the sample is loaded into a buffer.  You can view the buffer in the
 ; scope window too.  Click in the scope tab on the right, and evaluate this.
-(scope-buf flute-buf)
+(scope :buf flute-buf)

 ; If you just want to play a buffer and adjust the speed or looping
 ; play-buf is probably the easiest way.


loading dummy baskets from server on init

--- src/eatme/controllers/api.clj
+++ src/eatme/controllers/api.clj
@@ -1,4 +1,6 @@
 (ns eatme.controllers.api)
+
+(def basket-store (atom {}))

 (defn ping-the-api [pingback]
   (str "You have hit the API with: " pingback))


cleaning up some debug info

cleaning up some debug info

--- support/src/figwheel/auto_builder.clj
+++ support/src/figwheel/auto_builder.clj
@@ -16,40 +16,6 @@
                (fn [f] (.lastModified f)))
                (map :source-file files)))))

-(comment
-
-  (def options {
-                :output-to "resources/public/js/compiled/example.js"
-                :output-dir "resources/public/js/compiled/out"
-                  :optimizations :none
-                  :warnings true
-                })
-
-  (def fig-opts {
-                :output-to "resources/public/js/compiled/example.js"
-                :output-dir "resources/public/js/compiled/out"
-
-                 :resource-paths ["/Users/brucehauman/workspace/lein-figwheel/example/dev-resources"
-                                  "/Users/brucehauman/workspace/lein-figwheel/example/resources"
-                                  "/Users/brucehauman/workspace/lein-figwheel/example/other_resources"],
-                 ;; these aren't needed anymore
-                 :js-dirs ["resources/public/js/compiled/out" "resources/public/js/compiled/example.js"],
-                 :name "figwheel-example",
-                 :server-port 3449,
-
-                 :open-file-command "emacsclient",
-                 :root "/Users/brucehauman/workspace/lein-figwheel/example",
-                 :version "0.1.7-SNAPSHOT",
-                 :css-dirs ["resources/public/css"],
-                 :http-server-root "public"})
-
-  (get-dependency-mtimes ["src"] options)
-
-
-  (autobuild ["src"] options fig-opts)
-
-  )
-
 (def server-kill-switch (atom false))

 (defn autobuild [src-dirs build-options figwheel-options]
@@ -62,9 +28,10 @@
         warning-handlers (conj cljs.analyzer/*cljs-warning-handlers* warning-handler)
         compiler-env    (cljs.env/default-compiler-env build-options)]
     (reset! server-kill-switch (:http-server figwheel-state'))
-    (p/pprint src-dirs)
-    (p/pprint build-options)
-    (p/pprint figwheel-options)
+
+    #_(p/pprint src-dirs)
+    #_(p/pprint build-options)
+    #_(p/pprint figwheel-options)

     (loop [dependency-mtimes {}]
       (let [new-mtimes (get-dependency-mtimes src-dirs build-options)]
@@ -79,10 +46,4 @@
               (fig/compile-error-occured figwheel-state' e))))
         (fig/check-for-css-changes figwheel-state')
         (Thread/sleep 100)
-        #_(fig/stop-server figwheel-state')
         (recur new-mtimes)))))
-
-(comment
-  (require 'figwheel.auto-builder)
-  (in-ns 'figwheel.auto-builder)
-  )


Reorganization to help me think about things better.

--- src/clj/freefrog/governance.clj
+++ src/clj/freefrog/governance.clj
@@ -34,6 +34,45 @@
 (ns freefrog.governance
   (:require [clojure.set :as s]))

+;; ## General purpose utility functions ##
+
+(defn- entity-path
+  [role-name entities]
+  (concat [:roles role-name] entities))
+
+(defn- role-path
+  [role-name & entities]
+  (entity-path role-name entities))
+
+(defn- get-role [circle role-name]
+  (get-in circle (role-path role-name)))
+
+(defn- get-entity-raw
+  [circle role-name entities]
+  (get-in circle (entity-path role-name entities)))
+
+(defn- get-entity
+  "Same as get-entity-raw but nicer."
+  [circle role-name & entities]
+  (get-entity-raw circle role-name entities))
+
+;; ## Validators ##
+
+(defn- validate [valid? err-msg]
+  (when-not valid? (throw (IllegalArgumentException. err-msg))))
+
+(defn- validate-not [invalid? err-msg]
+  (validate (not invalid?) err-msg))
+
+(defn- validate-role-exists [circle role-name]
+  (validate-not (empty? (get-role circle role-name))
+                (str "Role not found: " role-name)))
+
+(defn- validate-role-name [role-name]
+  (validate-not (empty? role-name) "Name may not be empty"))
+
+;; ## Types ##
+
 (defprotocol GovernanceRecord
   (is-circle? [r]))

@@ -63,33 +102,19 @@
         (assoc-if :domains domains)
         (assoc-if :accountabilities accountabilities))))

-;; ## General purpose utility functions ##
-
-(defn- entity-path
-  [role-name entities]
-  (concat [:roles role-name] entities))
-
-(defn- role-path
-  [role-name & entities]
-  (entity-path role-name entities))
-
-(defn- get-role [circle role-name]
-  (get-in circle (role-path role-name)))
-
-(defn- get-entity-raw
-  [circle role-name entities]
-  (get-in circle (entity-path role-name entities)))
-
-(defn- get-entity
-  "Same as get-entity-raw but nicer."
-  [circle role-name & entities]
-  (get-entity-raw circle role-name entities))
+(defn create-circle
+  "Create a new circle with no parent."
+  [name]
+  (validate-not (empty? name) "Name may not be empty")
+  (map->Circle {:name name}))

 (defn is-subrole-circle?
   "Returns true if the given circle really is a circle. If you give it a
   role, it will tell you if the given role inside the given circle is a circle."
   [circle role-name]
   (is-circle? (get-role circle role-name)))
+
+;; ## Generalization Functions ##

 (defn- update-role-raw
   "Generalizes any role manipulation. The entity-path is the path to the entity
@@ -131,21 +156,6 @@
   (let [update-args
         (concat [circle (interleave (repeat :roles) path) fn] params)]
     (apply update-in update-args)))
-
-;; ## Validators ##
-
-(defn- validate [valid? err-msg]
-  (when-not valid? (throw (IllegalArgumentException. err-msg))))
-
-(defn- validate-not [invalid? err-msg]
-  (validate (not invalid?) err-msg))
-
-(defn- validate-role-exists [circle role-name]
-  (validate-not (empty? (get-role circle role-name))
-                (str "Role not found: " role-name)))
-
-(defn- validate-role-name [role-name]
-  (validate-not (empty? role-name) "Name may not be empty"))

 (defn- validate-role-updates [circle role-name]
@@ -180,12 +190,6 @@
   (-> circle
       (update-role role-name map->Role)
       (update-role role-name dissoc :roles)))
-
-(defn create-circle
-  "Create a new circle with no parent."
-  [name]
-  (validate-not (empty? name) "Name may not be empty")
-  (map->Circle {:name name}))

 (defn add-role
   "Adds a role to a circle.  The role may not conflict with an existing role.


Clean up loose ends (formatting/dead code removal)

--- src/clj/robinson/glterminal.clj
+++ src/clj/robinson/glterminal.clj
@@ -90,47 +90,14 @@
   (int (Math/pow 2 (inc (Math/floor (/ (Math/log v) (Math/log 2)))))))

 ;; A sequence of [character underline?]
-(def characters
-  (let [c (concat
-            "abcdefghijklmnopqrstuvwxyz"
-            "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
-            " ~!@#$%^&*()_-+=[]{}|:;,./<>?'\""
-            "\u005C"
-            "\u00A7"
-            "\u00B7"
-            "\u01C1"
-            "\u039B"
-            "\u03B1"
-            "\u03C2"
-            "\u2206"
-            "\u2225"
-            "\u2240"
-            "\u2248"
-            "\u2500"
-            "\u2502"
-            "\u250C"
-            "\u2514"
-            "\u2518"
-            "\u2534"
-            "\u2584"
-            "\u2592"
-            "\u2648"
-            "\u2665"
-            "\u1D16"
-            "\u255a"
-            "\u2550"
-            "\u255d"
-            "\u2551"
-            "\u2554"
-            "\u2557"
-            "\u00B0"
-            "\u2191")
-       c (concat (map vector c (repeat false))
-                 (map vector c (repeat true)))]
-    c))
+(defn displayable-characters [font]
+  (let [chars (map char (filter (fn [c] (.canDisplay font (char c))) (range 0x0000 0xFFFF)))]
+    (concat (map vector chars (repeat false))
+            (map vector chars (repeat true)))))

 ;; A sequence of [[\character underline?] x y] where [x y] is the column,row in the character atlas.
-(def character-idxs
+(defn character-idxs
+  [characters]
   ;(let [character-matrix (partition-all (int (inc (Math/sqrt (count characters)))) characters)]
   (let [characters-per-line (int (inc (Math/sqrt (count characters))))
         character-matrix    (partition-all characters-per-line characters)]
@@ -142,25 +109,28 @@
                                 line))
                  character-matrix))))

-(log/info "character-layout" (str (vec character-idxs)))

 ;; Map [\character underline?] to [col row]
 (def character->col-row
-  (reduce (fn [m [c-underline? x y]]
-            (assoc m c-underline? [x y]))
-          {}
-          character-idxs))
+  (memoize (fn [character-idxs]
+             (reduce (fn [m [c-underline? x y]]
+                       (assoc m c-underline? [x y]))
+                     {}
+                     character-idxs))))

 (defn make-glyph-image
   [char-width char-height font]
   ;; Adjust canvas to fit character atlas size
-  (let [cwidth  (next-pow-2 (* char-width (int (inc (Math/sqrt (count characters))))))
-        cheight (next-pow-2 (* char-height (int (inc (Math/sqrt (count characters))))))
-        width   (max cwidth cheight)
-        height  (max cwidth cheight)
-        antialias true
+  (let [characters (displayable-characters font)
+        cwidth     (next-pow-2 (* char-width (int (inc (Math/sqrt (count characters))))))
+        cheight    (next-pow-2 (* char-height (int (inc (Math/sqrt (count characters))))))
+        width      (max cwidth cheight)
+        height     (max cwidth cheight)
+        antialias  true
         font-metrics  ^FontMetrics (.getFontMetrics (Canvas.) font)]
     (log/info "glyph image width" width "height" height)
+    (log/info "characters" (vec characters))
+    (log/info "character-idxs" (vec (character-idxs characters)))
     (let [texture-image    (BufferedImage. width height BufferedImage/TYPE_4BYTE_ABGR)
           texture-graphics ^Graphics (.getGraphics texture-image)
           white            (Color. 255 255 255 255)]
@@ -174,7 +144,7 @@
         (.setColor (Color. 0 0 0 0))
         (.fillRect 0 0 width height))
       ;; Loop through each character, drawing it
-      (doseq [[[s underline?] col row]  character-idxs]
+      (doseq [[[s underline?] col row]  (character-idxs characters)]
         (let [x ^int (* col char-width)
               y ^int (* (inc row) char-height)
               cx (+ 0 x)
@@ -411,8 +381,8 @@

 (defn- init-buffers []
   (let [vertices              (float-array [1.0   1.0  0.0,
-                                            0.0  1.0  0.0
-                                            0.0, 0.0 0.0
+                                            0.0   1.0  0.0
+                                            0.0,  0.0 0.0
                                             1.0   0.0 0.0])
         texture-coords        (float-array [1.0 1.0
                                             0.0 1.0
@@ -456,10 +426,6 @@
    (make-terminal-character character fg-color bg-color style nil nil nil))
   ([character fg-color bg-color style fx-character fx-fg-color fg-bg-color]
    (GLCharacter. character fg-color bg-color style fx-character fx-fg-color fg-bg-color)))
-  #_{:character character
-   :fg-color  fg-color
-   :bg-color  bg-color
-   :style     style}

 (defrecord OpenGlTerminal [^int columns
                            ^int rows
@@ -547,7 +513,7 @@
              {:keys [^ByteBuffer glyph-image-data
                      ^ByteBuffer fg-image-data
                      ^ByteBuffer bg-image-data]} :data
-             :keys [p-matrix-buffer mv-matrix-buffer character-width character-height]} gl
+             :keys [p-matrix-buffer mv-matrix-buffer character-width character-height character->col-row]} gl
             glyph-image-data glyph-image-data
             fg-image-data fg-image-data
             bg-image-data bg-image-data
@@ -701,6 +667,7 @@
     (let [is-windows       (>= (.. System (getProperty "os.name" "") (toLowerCase) (indexOf "win")) 0)
           normal-font      (atom nil)
           _                (log/info "Using font" normal-font)
+          boxy-font        (make-font "fonts/Boxy/Boxy.ttf" Font/PLAIN 24)
           font-textures    (atom {})
           antialias        (atom antialias)
           _                (add-watch
@@ -771,7 +738,6 @@
           texture-coords-vertex-attribute (GL20/glGetAttribLocation pgm-id "aTextureCoord")

           ;; We just need one vertex buffer, a texture-mapped quad will suffice for drawing the terminal.
-
           {:keys [vertices-vbo-id
                   vertices-count
                   texture-coords-vbo-id]} (init-buffers)
@@ -802,6 +768,7 @@
                                                                       [screen-width screen-height 1.0])
                             :character-width character-width
                             :character-height character-height
+                            :character->col-row (character->col-row (character-idxs (displayable-characters boxy-font)))
                             :buffers {:vertices-vbo-id vertices-vbo-id
                                       :vertices-count vertices-count
                                       :texture-coords-vbo-id texture-coords-vbo-id}


Add fact binding support

Add fact binding support

--- src/clj/todomvc/tuple_rule.cljc
+++ src/clj/todomvc/tuple_rule.cljc
@@ -65,22 +65,36 @@
        :a (second tuple)
        :v (last tuple)})))

+(defn parse-as-tuple [expr]
+  (let [tuple     (first expr)
+        bindings  (tuple-bindings tuple)
+        attribute (if (keyword? (second tuple)) (second tuple) :all)]
+    (println "Tuple: " tuple)
+    (reduce
+      (fn last-one [condition [k v]]
+        (println "K V" k v)
+        (conj condition (list '= v (symbol (name k)))))
+      (vector attribute (vector ['e 'a 'v]))
+      bindings)))
+
+(defn parse-with-fact-expression [expr]
+  (let [fact-expression (take 2 expr)
+         expression (drop 2 expr)]
+   (conj (lazy-seq (parse-as-tuple expression))
+         (second fact-expression)
+         (first fact-expression))))
+
+
 (defn rewrite-lhs [exprs]
   (mapv (fn main-one [expr]
-          (println "expr" expr)
-          (println "is op" (dsl/ops (first expr)))
-          (if (dsl/ops (first expr))
-            expr
-            (let [tuple     (first expr)
-                  bindings  (tuple-bindings tuple)
-                  attribute (if (keyword? (second tuple)) (second tuple) :all)]
-              (println "Bindings: " bindings)
-              (reduce
-                (fn last-one [condition [k v]]
-                  (println "K V" k v)
-                  (conj condition (list '= v (symbol (name k)))))
-                (vector attribute (vector ['e 'a 'v]))
-                bindings))))
+          (let [leftmost (first expr)
+                op (keyword? (dsl/ops leftmost))
+                fact-expression (and (not (keyword? leftmost))
+                                     (is-binding? leftmost))]
+            (cond
+              op expr
+              fact-expression (parse-with-fact-expression expr)
+              :else (parse-as-tuple expr))))
     exprs))

 #?(:clj
@@ -105,14 +119,15 @@
              body       (if doc (rest body) body)
              properties (if (map? (first body)) (first body) nil)
              definition (if properties (rest body) body)
-             {:keys [lhs rhs]} (dsl/split-lhs-rhs definition)]
+             {:keys [lhs rhs]} (dsl/split-lhs-rhs definition)
+             lhs-detuplified (rewrite-lhs lhs)]
          ;(println "LHS in" lhs)
-         ;(println "LHS out" (rewrite-lhs lhs))
+         (println "LHS out" lhs-detuplified)
          (when-not rhs
            (throw (ex-info (str "Invalid rule " name ". No RHS (missing =>?).")
                     {})))
          `(def ~(vary-meta name assoc :rule true :doc doc)
-            (cond-> ~(dsl/parse-rule* (rewrite-lhs lhs) rhs properties {} (meta &form))
+            (cond-> ~(dsl/parse-rule* lhs-detuplified rhs properties {} (meta &form))
               ~name (assoc :name ~(str (clojure.core/name (ns-name *ns*)) "/" (clojure.core/name name)))
               ~doc (assoc :doc ~doc)))))))

@@ -121,6 +136,23 @@
 ;LHS ([:todo/title [[e a v]] (= ?e e)] [:exists [:todo/done]])
 (rewrite-lhs '([[?e :todo/title _]] [:exists [:todo/done]]))

+(macroexpand
+  '(def-tuple-rule my-tuple-rule
+     "Docstring!!"
+     [?todo <- [?e :todo/title v]]
+     [:exists [:todo/done]]
+     =>
+     (println "Hello!")))
+
+(macroexpand
+  '(defrule my-regular-rule
+     "Docstring!!"
+     [?todo <- :todo/title [[e a v]] (= ?e e)]
+     [:exists [:todo/done]]
+     =>
+     (println "Hello!")))
+
+;TODO. Test these. Should be equivalent as of 23814274a376f12535c455a55ed9d5e85c81f5c9
 (macroexpand
   '(def-tuple-rule my-tuple-rule
      "Docstring!!"


Simplify route definitions

Simplify route definitions

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -48,11 +48,10 @@
 (defroute "/" []
   (session/put! :current-page site-list))

-(defroute "/site/:site" []
+(defroute "/site/:site" [site]
   (session/put! :current-page comic-list))

-(defroute "/comic/:comic/:volume/:page"
-  {:keys [comic volume page]}
+(defroute "/comic/:comic/:volume/:page" [comic volume page]
   (session/put! :current-page comic-viewer))

 (defn page []


Expose pipeline actions as <a>

Expose pipeline actions as <a>

This change enables us to navigate with the keyboard more easily.

--- src/cljs/lambdacd/pipeline.cljs
+++ src/cljs/lambdacd/pipeline.cljs
@@ -48,11 +48,25 @@
     "container" :ol
     nil))

+(defn- step-icon-classes [status]
+  (case status
+    "kill" "fa fa-times"
+    "trigger" "fa fa-play"
+    "retrigger" "fa fa-repeat"
+    "expand" "fa fa-plus"
+    "killed"  "fa fa-bug"
+    "collapse" "fa fa-minus"))
+
+(defn step-icon [status build-step]
+  [:i {:class (step-icon-classes status) :alt (str status " " (:name build-step))}])
+
 (defn retrigger-component [build-number build-step]
   (if (is-finished build-step)
     (if (has-dependencies build-step)
       [:i {:class "fa fa-repeat pipeline__step__action-button pipeline__step__action-button--disabled" :title "this step can not be safely retriggered as it depends on previous build steps"}]
-      [:i {:class "fa fa-repeat pipeline__step__action-button" :on-click (click-handler #(api/retrigger build-number (step-id-for build-step)))}])))
+      [:a {:class    "pipeline__step__action-button"
+           :on-click (click-handler #(api/retrigger build-number (step-id-for build-step)))}
+       (step-icon "retrigger" build-step)])))

 (defn ask-for [parameters]
   (into {} (doall (map (fn [[param-name param-config]]
@@ -65,11 +79,14 @@

 (defn kill-component [build-number build-step]
   (if (can-be-killed? build-step)
-    [:i {:class "fa fa-times pipeline__step__action-button" :on-click (click-handler #(api/kill build-number (step-id-for build-step)))}]))
+    [:a {:class    "pipeline__step__action-button"
+         :on-click (click-handler #(api/kill build-number (step-id-for build-step)))}
+     (step-icon "kill" build-step)]))

 (defn active-manual-trigger-component [build-step]
-  [:i {:class    "fa fa-play pipeline__step__action-button"
-       :on-click (click-handler #(manual-trigger (:result build-step)))}])
+  [:a {:class    "pipeline__step__action-button"
+       :on-click (click-handler #(manual-trigger (:result build-step)))}
+   (step-icon "trigger" build-step)])

 (defn inactive-manual-trigger-component []
   [:i {:class "fa fa-play pipeline__step__action-button pipeline__step__action-button--disabled"}])
@@ -89,10 +106,13 @@
 (let [is-expanded (re-frame/subscribe [::db/step-expanded? step-id])]
   (fn [{step-id :step-id :as build-step}]
     (if (expandable? build-step)
-      [:i {:class    (classes "fa" "pipeline__step__action-button" (if @is-expanded "fa-minus" "fa-plus"))
+      [:a {:class    "pipeline__step__action-button"
            :on-click (fn [event]
                        (re-frame/dispatch [::db/toggle-step-expanded step-id])
-                       nil)}]))))
+                       nil)}
+       (if @is-expanded
+         (step-icon "collapse" build-step)
+         (step-icon "expand" build-step))]))))

 (declare build-step) ;; mutual recursion


fix nested list issue

fix nested list issue

--- src/graphql_clj/execution.clj
+++ src/graphql_clj/execution.clj
@@ -23,7 +23,7 @@
                          (let [fragment-grouped-field-set (collect-fields (:type selection) (:selection-set selection) {} state)]
                            (reduce (fn [result [name selection]]
                                      (println "result:" result "name:" name "selection:" selection)
-                                     (update result name conj selection))
+                                     (update result name concat selection))
                                    result
                                    fragment-grouped-field-set))))))


vec not needed.

vec not needed.

Must have been evaluating out of order before.
This conversion is not needed.

--- src/haystack/create_index.clj
+++ src/haystack/create_index.clj
@@ -79,7 +79,7 @@
         :snowball-filter {:type "snowball"
                           :language "English"}
         :synonym-filter {:type "synonym"
-                         :synonyms (vec (synonyms))}
+                         :synonyms (synonyms)}
         }

        :tokenizer
@@ -89,7 +89,6 @@
         :scrunch-tokenizer {:type "nGram"
                             :min_gram "4"
                             :max_gram "15"}
-        ;; :part-num-tokenizer {:type "ngram" :min_gram 3 :max_gram 8}
         }

        :analyzer


first successfull run!

first successfull run!

--- src/hypertext_ray/finders.clj
+++ src/hypertext_ray/finders.clj
@@ -130,8 +130,7 @@

 ;
-;
-;
+; below here, mainly functions dealing with extracting data
 ;

 (def itables (atom nil)) ;vector of indexed tables for current page


Did the obvious to the object names.

Did the obvious to the object names.

--- src/conexp/gui/editors/contexts.clj
+++ src/conexp/gui/editors/contexts.clj
@@ -276,6 +276,41 @@
                            model-column current-name
                            model-column new-name))))
                    new-name))))
+
+           change-object-name
+           (fn-doc "This function will change the name of the object in
+  the specified row to the new given name, if the new name does not conflict,
+  or otherwise to a conflict free new name; and returns the new name of the
+  object.
+
+  Parameters:
+    model-row      _row of the object in the model
+    req-name       _requested new object name"
+             [model-row req-name]
+             (dosync-wait
+               (let [ objs (objects (get-context @context))
+                      current-name (@obj-rows model-row)
+                      other-objs (disj objs current-name)
+                      new-name (req-unique-string other-objs
+                                 req-name) ]
+                 (do
+                   (if (not= current-name new-name)
+                     (let [ omap (fn [x] (if (= x current-name) new-name x))]
+                       (dosync
+                         (commute context
+                           (fn [x] (let [os (conj (disj (objects x)
+                                                    current-name)
+                                              new-name)
+                                         as (attributes x)
+                                         inc (map
+                                               (fn [x] [ (omap (first x))
+                                                         (second x)])
+                                               (incidence x))]
+                                     (make-context os as inc))))
+                         (commute obj-rows switch-bipartit-auto
+                           model-row current-name
+                           model-row new-name))))
+                   new-name))))

            set-cell-value-hook
            (fn-doc "This hook is called when a cell's value in the table widget
@@ -298,8 +333,12 @@
                       (let [attrib-cols @attr-cols
                             current-name (attrib-cols model-column)]
                         (if (= contents current-name) current-name
-                             (change-attribute-name model-column contents)))
-                      (= model-column 0) "Object name"
+                          (change-attribute-name model-column contents)))
+                      (= model-column 0)
+                      (let [object-rows @obj-rows
+                             current-name (object-rows model-row)]
+                        (if (= contents current-name) current-name
+                          (change-object-name model-row contents)))
                       true contents)
                     other-widgets (filter
                                     (fn [w] (not= (w :table) table))


Link to checker page.

Link to checker page.

--- src/midje/fakes.clj
+++ src/midje/fakes.clj
@@ -107,7 +107,7 @@
     (println "-- WARNING: In this version, prerequisite arguments that are functions are")
     (println "-- considered checkers. In the near future, they'll be considered ordinary")
     (println "-- values. If you want them to be checkers, you need to declare them as")
-    (println "-- such. <link to doc>")
+    (println "-- such. See https://github.com/marick/Midje/wiki/Checkers-within-prerequisites")
     (println "-- The function argument I'm objecting to is:")
     (println "--    " (attractively-stringified-form expected))
     (println "--     in" (nth (without-clojure-strings (stacktrace-as-strings (Throwable.))) 12))


Fixed docstring.

Fixed docstring.

--- src/kademlia/core.clj
+++ src/kademlia/core.clj
@@ -14,8 +14,7 @@

 (defn attempt-to-thaw-msg
-  "Returns the parsed serialized data, if we failed to parse it return nil.:
-  {:type :invalid-data}"
+  "Returns the parsed serialized data, if we failed to parse it return nil."
   [msg]
   (try
     (nippy/thaw msg)


Reimplement with-swing-error-msg using seesaw.core/dialog

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

--- src/conexp/contrib/gui/util.clj
+++ src/conexp/contrib/gui/util.clj
@@ -52,13 +52,13 @@
   `(try
      ~@body
      (catch Exception e#
-       (javax.swing.JOptionPane/showMessageDialog
-        ~frame
-        (scrollable (text :text (apply str (root-cause e#) "\n"
-                                       (interpose "\n" (.getStackTrace e#)))
-                          :multi-line? true))
-        ~title
-        javax.swing.JOptionPane/ERROR_MESSAGE))))
+       (show!
+        (dialog :parent ~frame
+                :content (scrollable (text :text (apply str (root-cause e#) "\n"
+                                                        (interpose "\n" (.getStackTrace e#)))
+                                           :multi-line? true))
+                :type :error
+                :title ~title)))))

 (defn get-component
   "Returns the first component in component satisfing predicate."


Simplify mouse listener for tab button

Simplify mouse listener for tab button

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

--- src/conexp/contrib/gui/util.clj
+++ src/conexp/contrib/gui/util.clj
@@ -14,7 +14,7 @@
                         JOptionPane JComponent]
            [javax.swing.filechooser FileNameExtensionFilter]
            [java.awt Color Dimension Graphics Graphics2D BasicStroke FlowLayout]
-           [java.awt.event  MouseAdapter MouseEvent]
+           [java.awt.event MouseEvent]
            [javax.swing.event ChangeListener ChangeEvent]
            [java.io File])
   (:use [conexp.base :only (defvar, defmacro-, first-non-nil, illegal-argument)])
@@ -156,19 +156,21 @@
                                           (- (.  this getHeight) delta 1))
                                (.drawLine g2 (- (. this getWidth) delta 1) delta
                                           delta (- (. this getHeight) delta 1))
-                               (.dispose g2))))),
-        mouse-listener (proxy [MouseAdapter] []
-                         (mouseEntered [^MouseEvent evt]
-                           (let [component (.getComponent evt)]
-                             (when (instance? AbstractButton component)
-                               (.setBorderPainted ^AbstractButton component true))))
-                         (mouseExited [^MouseEvent evt]
-                           (let [component (.getComponent evt)]
-                             (when (instance? AbstractButton component)
-                               (.setBorderPainted ^AbstractButton component false)))))]
+                               (.dispose g2)))))]
     (doto tabbutton
-      (listen :action (fn [_] (.remove tabpane (.indexOfComponent tabpane component))))
-      (.addMouseListener mouse-listener)
+      (listen :action
+              (fn [_]
+                (.remove tabpane (.indexOfComponent tabpane component))))
+      (listen :mouse-entered
+              (fn [^MouseEvent evt]
+                (let [component (.getComponent evt)]
+                  (when (instance? AbstractButton component)
+                    (.setBorderPainted ^AbstractButton component true)))))
+      (listen :mouse-exited
+              (fn [^MouseEvent evt]
+                (let [component (.getComponent evt)]
+                  (when (instance? AbstractButton component)
+                    (.setBorderPainted ^AbstractButton component false)))))
       (.setPreferredSize (Dimension. 17 17))
       (.setToolTipText "Close this tab")
       (.setContentAreaFilled false)


Gah, error in proper-premise?

Gah, error in proper-premise?

Fixed that.

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -193,7 +193,8 @@
   "Returns true iff set A is a subset of the attributes of context ctx
   and is a proper premise in ctx."
   [ctx A]
-  (not (empty? (A-dot ctx A))))
+  (and (subset? A (attributes ctx))
+       (not (empty? (A-dot ctx A)))))

 (defn- subset-minimal
   "Returns from a sequence of sets all sets which are minimal wrt


Make the system implementation level components backwards compatible.

--- src/onyx/system.clj
+++ src/onyx/system.clj
@@ -109,29 +109,33 @@
      :log (component/using (zookeeper config) [:logging-config])}))

 (defn onyx-client
-  [peer-config monitoring-config]
-  (map->OnyxClient
-   {:monitoring (extensions/monitoring-agent monitoring-config)
-    :messaging-require (messaging-require-ctor peer-config)
-    :log (component/using (zookeeper peer-config) [:monitoring])}))
+  ([peer-config]
+     (onyx-client peer-config {:monitoring :no-op}))
+  ([peer-config monitoring-config]
+     (map->OnyxClient
+      {:monitoring (extensions/monitoring-agent monitoring-config)
+       :messaging-require (messaging-require-ctor peer-config)
+       :log (component/using (zookeeper peer-config) [:monitoring])})))

 (defn onyx-peer
-  [{:keys [config] :as peer-group} monitoring-config]
-  (map->OnyxPeer
-   {:monitoring (extensions/monitoring-agent monitoring-config)
-    :messaging-require (messaging-require-ctor config)
-    :log (component/using (zookeeper config) [:monitoring])
-    :acking-daemon (component/using (acking-daemon config) [:monitoring :log])
-    :messenger-buffer (component/using (messenger-buffer config)[:monitoring :log :acking-daemon])
-    :messenger (component/using (messenger-ctor peer-group)
-                                [:monitoring :messaging-require :acking-daemon :messenger-buffer])
-    :virtual-peer (component/using (virtual-peer config)
-                                   [:monitoring :log :acking-daemon :messenger-buffer :messenger])}))
+  ([peer-group]
+     (onyx-peer peer-group {:monitoring :no-op}))
+  ([{:keys [config] :as peer-group} monitoring-config]
+     (map->OnyxPeer
+      {:monitoring (extensions/monitoring-agent monitoring-config)
+       :messaging-require (messaging-require-ctor config)
+       :log (component/using (zookeeper config) [:monitoring])
+       :acking-daemon (component/using (acking-daemon config) [:monitoring :log])
+       :messenger-buffer (component/using (messenger-buffer config)[:monitoring :log :acking-daemon])
+       :messenger (component/using (messenger-ctor peer-group)
+                                   [:monitoring :messaging-require :acking-daemon :messenger-buffer])
+       :virtual-peer (component/using (virtual-peer config)
+                                      [:monitoring :log :acking-daemon :messenger-buffer :messenger])})))

 (defn onyx-peer-group
   [config]
   (map->OnyxPeerGroup
-    {:config config
-     :logging-config (logging-config/logging-configuration config)
-     :messaging-require (messaging-require-ctor config)
-     :messaging-group (component/using (messaging-peer-group-ctor config) [:messaging-require :logging-config])}))
+   {:config config
+    :logging-config (logging-config/logging-configuration config)
+    :messaging-require (messaging-require-ctor config)
+    :messaging-group (component/using (messaging-peer-group-ctor config) [:messaging-require :logging-config])}))


Элемент select и функционал работы с временем

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -13,6 +13,8 @@

             [clojure.set :as clojset]
             [clojure.string :as clojstr]
+
+            [goog.i18n.DateTimeFormat :as dtf]
             )

   (:import [goog.dom query]))
@@ -36,7 +38,78 @@
 ;; END Common functions and tools
 ;;..................................................................................................

-
+;;**************************************************************************************************
+;;* BEGIN Dates and Times
+;;* tag: <date time timestamp>
+;;*
+;;* description: функции работы со временем
+;;*
+;;**************************************************************************************************
+
+;; (defn convert-to-array [js-col]
+;;   (-> (clj->js [])
+;;       (.-slice)
+;;       (.call js-col)
+;;       (js->clj)))
+
+;;**************************************************************************************************
+;;* BEGIN date and time functions
+;;* tag: <date and time functions>
+;;*
+;;* description: Работа с датами и временем
+;;* примеры
+;; 1 форматирование
+;;(.format (goog.i18n.DateTimeFormat. (.-LONG_DATE goog.i18n.DateTimeFormat.Format)) (js/Date.))
+;; 2 получение из стороки и форматирование
+;;(.format (goog.i18n.DateTimeFormat. (.-LONG_DATE goog.i18n.DateTimeFormat.Format))
+;;  (new js/Date (.parse js/Date (get-in row [:webdoc-row :udate]))))
+;;**************************************************************************************************
+
+(def date-formats
+  (let [f goog.i18n.DateTimeFormat.Format]
+    {:FULL_DATE (.-FULL_DATE f)
+     :FULL_DATETIME (.-FULL_DATETIME f)
+     :FULL_TIME (.-FULL_TIME f)
+     :LONG_DATE (.-LONG_DATE f)
+     :LONG_DATETIME (.-LONG_DATETIME f)
+     :LONG_TIME (.-LONG_TIME f)
+     :MEDIUM_DATE (.-MEDIUM_DATE f)
+     :MEDIUM_DATETIME (.-MEDIUM_DATETIME f)
+     :MEDIUM_TIME (.-MEDIUM_TIME f)
+     :SHORT_DATE (.-SHORT_DATE f)
+     :SHORT_DATETIME (.-SHORT_DATETIME f)
+     :SHORT_TIME (.-SHORT_TIME f)
+     }))
+
+
+(defn str-to-date [date-string]
+  (new js/Date (.parse js/Date date-string)))
+
+(defn format-date
+  "Format a date using either the built-in goog.i18n.DateTimeFormat.Format enum
+  or a formatting string like \"dd MMMM yyyy\"
+  examples:
+  > (format-date-generic :LONG_DATE (js/Date.))
+  > \"July 14, 2012\"
+  > (format-date-generic \"dd MMMM yyyy\" (js/Date.))
+  > \"14 July 2012\"
+  > (format-date-generic \"MMMM\" (js/Date.))
+  > \"July\"
+  "
+  [date-format date]
+  (.format (goog.i18n.DateTimeFormat. (or (date-formats date-format) date-format))  date))
+
+(defn str-to-date-and-format [date-format alt-string s]
+  (if (nil? s) alt-string
+      (format-date date-format (str-to-date s))))
+
+;; END date and time functions
+;;..................................................................................................
+
+
+
+;; END Dates and Times
+;;..................................................................................................

 ;;**************************************************************************************************
 ;;* BEGIN icons
@@ -631,6 +704,70 @@
 ;; END input
 ;;..................................................................................................

+;;**************************************************************************************************
+;;* BEGIN input select
+;;* tag: <input select>
+;;*
+;;* description: Выбор из списка
+;;*
+;;**************************************************************************************************
+
+(def select-app-init
+  {:selected nil
+   :list []})
+
+(def no-select-v "NO-SELECT")
+
+(defn select-app-list-set! [app new-list]
+  (assoc app :list new-list))
+
+(defn select-app-selected-set! [app selected]
+  (assoc app :selected (str selected)))
+
+(defn select-app-selected [app]
+  (let [sv (app :selected)]
+    (if (= sv no-select-v) nil sv)))
+
+
+(defn select [app _ {:keys [on-change-fn]}]
+  (reify
+    om/IRender
+    (render [_]
+      (println "SELECT APP:" @app)
+      (dom/select
+       #js {:value (@app :selected)
+            :className "form-control"
+            :onChange
+            (fn [e]
+              (let [v (-> e .-target .-value)]
+                (om/update! app :selected v)
+                (when on-change-fn (on-change-fn v))))}
+
+       (doall
+        (map (fn [{:keys [id title keyname]}]
+               (println id title keyname)
+               (dom/option #js {:value (str id)} keyname " " title))
+             (into [{:id no-select-v :title "Выбрать..."}] (@app :list)))) ))))
+
+(defn select-form-group  [app _ {:keys [label
+                                        type
+                                        spec-select]
+                                 :or {label "Метка"
+                                      spec-select {}}}]
+  (reify
+    om/IRender
+    (render [_]
+      (dom/div #js {:className (str "form-group " (input-css-string-has? app))}
+               (dom/label #js {:className "control-label col-sm-4 col-md-4 col-lg-4"} label)
+               (dom/div #js {:className "col-sm-8 col-md-8 col-lg-8"}
+                        (om/build select app {:opts spec-select})
+                        (om/build helper-p app {})
+                        )))))
+
+
+;; END input select
+;;..................................................................................................
+

 ;;**************************************************************************************************


fix up form

fix up form

--- src-cljs/views/head-form.cljs
+++ src-cljs/views/head-form.cljs
@@ -6,7 +6,7 @@

 (defn- get-value
   [event]
-  (.-target.value event))
+  (-> event .-target .-value))

 (def form-data (atom {}))

@@ -40,15 +40,17 @@

 (defn head-input
   []
-  (let [{:name head-name} @form-data]
-    [:input {:type "text"
-             :value head-name
-             :on-change (fn [ev]
-                          (swap! form-data assoc :name (get-value ev)))}]))
+  [:input {:type "text"
+           :value (:name @form-data)
+           :id "head-name"
+           :on-change (fn [ev]
+                        (swap! form-data assoc :name (get-value ev)))}])

 (defn submit-button
   [submit-url]
-  [:input {:type "button" :value "save" :on-click #(validate-form submit-url)}])
+  [:input.btn.medium.secondary {:type "button"
+           :value "Save"
+           :on-click #(validate-form submit-url)}])

 (defn head-form
   ([{:keys [csrf submit-url original-name] :or {original-name ""}}]
@@ -56,6 +58,10 @@
       (swap! form-data assoc :original-name original-name
                              :__anti-forgery-token csrf)
       (fn []
-        [:div
-          [head-input]
-          [submit-button submit-url]]))))
+        [:form.main
+          [:div
+            [:fieldset
+              [:div
+                [:label {:for "head-name"} "Head Name"]
+                [head-input]]]
+            [submit-button submit-url]]]))))


Work on expanding the description of a request body

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -5,11 +5,25 @@
   Adapter for ring-swagger. Converts an intermediate description of the namespaces
   into a description compatible with the ring-swagger library."
   (:require [schema.core :as s]
+            [io.aviso.rook.schema :refer [unwrap-schema]]
             [clojure.string :as str]
             [medley.core :as medley]
             [io.aviso.toolchest.macros :refer [cond-let]]
             [io.aviso.toolchest.collections :refer [pretty-print]]
-            [clojure.tools.logging :as l]))
+            [io.aviso.tracker :as t]
+            [clojure.tools.logging :as l]
+            [io.aviso.rook.utils :as utils])
+  (:import [schema.core EnumSchema Maybe]
+           [io.aviso.rook.schema IsInstance]))
+
+(defn- remove-nil-vals
+  [m]
+  (medley/remove-vals nil? m))
+
+(defn- remove-any-keys
+  "Removes keys that are equaly to s/Any."
+  [m]
+  (medley/remove-vals #(= s/Any %) m))

 (def default-swagger-skeleton
   "A base skeleton for a Swagger Object (as per the Swagger 2.0 specification), that is further populated from Rook namespace
@@ -43,6 +57,7 @@
         reducer (fn [so path-id]
                   (update-in so params-key
                              conj {:name     path-id
+                                   :type     :string        ; may add something later to refine this
                                    :in       :path
                                    :required :true}))]
     (reduce reducer swagger-object path-ids)))
@@ -53,51 +68,87 @@
   (cond (s/optional-key? schema-key)
         [(.k schema-key) false]

+        ;; This is the normal alternative to s/optional-key
+        (keyword? schema-key)
+        [schema-key true]
+
+        ;; This can happen in vector schemas, but is still legit in map schemas:
         (s/required-key? schema-key)
         [(.k schema-key) true]

-        (keyword? schema-key)
-        [schema-key true]
-
         :else
         (throw (RuntimeException. (format "No idea what to do with query schema key %s." schema-key)))))
+
+(defn- simple->swagger-schema
+  "Converts a simple (non-object) Schema into an inline Swagger Schema, with keys :type and perhaps :format, etc."
+  [swagger-options schema]
+  (cond-let
+    [data-type-mappings (:data-type-mappings swagger-options)
+     data (get data-type-mappings schema)]
+
+    (some? data)
+    data
+
+    (instance? EnumSchema schema)
+    {:type :string                                          ; an assumption
+     :enum (unwrap-schema schema)}
+
+    (instance? Maybe schema)
+    (assoc (simple->swagger-schema swagger-options (unwrap-schema schema))
+      :allowEmptyValue true)
+
+    ;; The i.a.r.schema/with-description macro often turns bare classes into an IsInstance
+    (instance? IsInstance schema)
+    (recur swagger-options (unwrap-schema schema))
+
+    ;; TODO: arrays
+
+    :else
+    (throw (ex-info (format "Unable to convert schema %s to Swagger." schema)
+                    {:schema schema}))))

 (defn default-query-params-injector
   "Identifies each query parameter via the :query-schema metadata and injects it."
   [swagger-options swagger-object routing-entry params-key]
   (if-let [schema (-> routing-entry :meta :query-schema)]
     ;; Assumes that the schema is a map.
-    (try
-      (let [reducer (fn [so [key-id key-schema]]
-                      (cond-let
-                        ;; Just ignore these, they are a convinience for the caller ("be generous in what you accept").
-                        (= s/Any key-id)
-                        so
-
-                        [[k required] (reduce-schema-key key-id)]
-
-                        :else
-                        (update-in so params-key
-                                   conj {:name     k
-                                         :in       :query
-                                         :required required})))]
-        (reduce reducer swagger-object schema))
-      (catch Exception e
-        (throw (ex-info "Unable to convert routing entry into Swagger data."
-                        routing-entry
-                        e))))
+    (let [reducer (fn [so [key-id key-schema]]
+                    (cond-let
+                      ;; Just ignore these, they are a convinience for the caller ("be generous in what you accept").
+                      (= s/Any key-id)
+                      so
+
+                      [[k required] (reduce-schema-key key-id)]
+
+                      :else
+                      (t/track
+                        (format "Describing query parameter `%s'." (name k))
+                        (let [schema-description (simple->swagger-schema swagger-options key-schema)
+                              full-description (assoc schema-description
+                                                 :name k
+                                                 :in :query
+                                                 :required required)]
+                          (update-in so params-key
+                                     conj full-description)))))]
+      (reduce reducer swagger-object schema))
     ; no :query-schema
     swagger-object))

-(defn schema->swagger-schema
+(defn map->swagger-schema
   [swagger-options schema]
-  ;; To be done!
-  (medley/remove-vals nil?
-                      {:required    []
-                       ;; :description is often provided by with-description, which overrides the normal docstring.
-                       :description (or (-> schema meta :description)
-                                        (-> schema meta :doc))
-                       :properties  {}}))
+  (let [reducer (fn [o [schema-key schema-value]]
+                  (let [[k required?] (reduce-schema-key schema-key)]
+                    (t/track
+                      #(format "Describing body key `%s'." (name k))
+                      (let [swagger-schema (simple->swagger-schema swagger-options schema-value)]
+                        (cond-> (assoc-in o [:properties k] swagger-schema)
+                                required? (update-in [:required] conj k))))))]
+    (->>
+      schema
+      remove-any-keys
+      (reduce reducer {:description (or (-> schema meta :description)
+                                        (-> schema meta :doc))})
+      remove-nil-vals)))

 (defn to-schema-reference
   "Converts a schema to a schema reference; the schema must be named.  Returns a tuple
@@ -120,7 +171,7 @@
     (some? swagger-schema)
     [swagger-object swagger-reference]

-    [new-schema (schema->swagger-schema swagger-options schema)
+    [new-schema (map->swagger-schema swagger-options schema)
      swagger-object' (assoc-in swagger-object [:definitions swagger-name] new-schema)]

     :else
@@ -129,28 +180,32 @@
 (defn default-body-params-injector
   "Uses the :body-schema metadata to identify the body params."
   [swagger-options swagger-object routing-entry paths-key]
-  (if-let [schema (-> routing-entry :meta :body-schema)]
-
-    ;; Assumption: it's a map and named
-    (let [[swagger-object' schema-reference] (to-schema-reference swagger-options swagger-object schema)]
-      (update-in swagger-object' paths-key
-                 conj {:name     :request-body
-                       :in       :body
-                       :required true
-                       :schema   schema-reference}))
-    ; no schema:
-    swagger-object))
+  (t/track
+    "Describing body parameters."
+    (if-let [schema (-> routing-entry :meta :body-schema)]
+
+      ;; Assumption: it's a map and named
+      (let [[swagger-object' schema-reference] (to-schema-reference swagger-options swagger-object schema)]
+        (update-in swagger-object' paths-key
+                   conj {:name     :request-body
+                         :in       :body
+                         :required true
+                         :schema   schema-reference}))
+      ; no schema:
+      swagger-object)))

 (defn default-responses-injector
   "Uses the :responses metadata to identify possible responses."
   [swagger-options swagger-object routing-entry paths-key]
   (let [responses (-> routing-entry :meta :responses)
         reducer (fn [so [status-code schema]]
-                  (let [schema-meta (meta schema)
-                        description (or (:description schema-meta)
-                                        (:doc schema-meta)
-                                        "Documentation not provided.")]
-                    (assoc-in so (concat paths-key [:responses (str status-code)]) {:description description})))]
+                  (t/track
+                    (format "Describing %d response." status-code)
+                    (let [schema-meta (meta schema)
+                          description (or (:description schema-meta)
+                                          (:doc schema-meta)
+                                          "Documentation not provided.")]
+                      (assoc-in so (concat paths-key [:responses (str status-code)]) {:description description}))))]
     (reduce reducer swagger-object responses)))

 (defn default-path-item-object-injector
@@ -172,10 +227,9 @@
         params-key (concat paths-key ["parameters"])]
     (as-> swagger-object %
           (assoc-in % paths-key
-                    (medley/remove-vals nil?
-                                        {:description  description
-                                         :summary      summary
-                                         :operation-id (:function endpoint-meta)}))
+                    (remove-nil-vals {:description  description
+                                      :summary      summary
+                                      :operation-id (:function endpoint-meta)}))
           (path-params-injector swagger-options % routing-entry params-key)
           (query-params-injector swagger-options % routing-entry params-key)
           (body-params-injector swagger-options % routing-entry params-key)
@@ -205,15 +259,19 @@

   Returns the modified swagger-object."
   [swagger-options swagger-object routing-entry]
-  (let [path-str (-> routing-entry :path path->str)
-        ;; Ignoring :all for the moment.
-        method-str (-> routing-entry :method name)
-        pio-constructor (:path-item-object-injector swagger-options)]
-    ;; Invoke the constructor for the path info. It may need to make changes to the :definitions, so we have
-    ;; to let it modify the entire Swagger object ... but we help it out by providing the path
-    ;; to where the PathInfoObject (which describes what Rook calls a "route").
-    (pio-constructor swagger-options swagger-object routing-entry
-                     [:paths path-str method-str])))
+  (t/track
+    (format "Describing endpoint %s `/%s'."
+            (-> routing-entry :method name .toUpperCase)
+            (->> routing-entry :path (str/join "/")))
+    (let [path-str (-> routing-entry :path path->str)
+          ;; Ignoring :all for the moment.
+          method-str (-> routing-entry :method name)
+          pio-constructor (:path-item-object-injector swagger-options)]
+      ;; Invoke the constructor for the path info. It may need to make changes to the :definitions, so we have
+      ;; to let it modify the entire Swagger object ... but we help it out by providing the path
+      ;; to where the PathInfoObject (which describes what Rook calls a "route").
+      (pio-constructor swagger-options swagger-object routing-entry
+                       [:paths path-str method-str]))))

 (defn- routing-entry->map
   [[method path _ endpoint-meta]]
@@ -227,10 +285,25 @@
   [swagger-options swagger-object routing-entries]
   swagger-object)

+(def default-data-type-mappings
+  {
+   s/Int   {:type :integer}
+   Integer {:type :integer :format :int32}
+   Long    {:type :integer :format :int64}
+   s/Num   {:type :number}
+   Float   {:type :number :format :float}
+   Double  {:type :number :format :double}
+   s/Str   {:type :string}
+   Byte    {:type :string :format :byte}
+   s/Bool  {:type :boolean}
+   s/Inst  {:type :string :format :date-time}
+   s/Uuid  {:type :string :format :uuid}})
+
 (def default-swagger-options
   {:skeleton                  default-swagger-skeleton
    :route-injector            default-route-injector
    :configurer                default-configurer
+   :data-type-mappings        default-data-type-mappings
    :path-item-object-injector default-path-item-object-injector
    :path-params-injector      default-path-params-injector
    :query-params-injector     default-query-params-injector
@@ -241,12 +314,14 @@
   "Constructs the root Swagger object from the Rook options, swagger options, and the routing table
   (part of the result from [[construct-namespace-handler]])."
   [swagger-options routing-table]
-  (let [{:keys [skeleton route-injector configurer]} swagger-options
-        routing-entries (->> routing-table
-                             vals
-                             (apply concat)
-                             (map routing-entry->map)
-                             ;; Endpoints with the :no-swagger meta data are ignored.
-                             (remove #(-> % :meta :no-swagger)))]
-    (as-> (reduce (partial route-injector swagger-options) skeleton routing-entries) %
-          (configurer swagger-options % routing-entries))))+  (t/track
+    "Constructing Swagger API Description."
+    (let [{:keys [skeleton route-injector configurer]} swagger-options
+          routing-entries (->> routing-table
+                               vals
+                               (apply concat)
+                               (map routing-entry->map)
+                               ;; Endpoints with the :no-swagger meta data are ignored.
+                               (remove #(-> % :meta :no-swagger)))]
+      (as-> (reduce (partial route-injector swagger-options) skeleton routing-entries) %
+            (configurer swagger-options % routing-entries)))))


Fix lengths to use 64-wide KATs

Fix lengths to use 64-wide KATs

--- test/caesium/crypto/generichash_test.clj
+++ test/caesium/crypto/generichash_test.clj
@@ -33,26 +33,30 @@

 (deftest generichash-kat-test
   (are [args expected] (array-eq (apply g/hash args) expected)
-    [(byte-array [])]
-    (blake2b-vector "digest-empty-string")
+    [(byte-array [])
+     {:size 64}]
+    (blake2b-vector "digest-empty-string-64")

-    [(byte-array [90])]
-    (blake2b-vector "digest-0")))
+    [(byte-array [90])
+     {:size 64}]
+    (blake2b-vector "digest-Z-64")))

 (deftest blake2b-kat-test
-  (testing "blake2b works directly"
-    (are [args expected] (array-eq (apply g/blake2b args) expected)
-      [(byte-array [])]
-      (blake2b-vector "digest-empty-string")
+  (are [args expected] (array-eq (apply g/blake2b args) expected)
+    [(byte-array [])
+     {:size 64}]
+    (blake2b-vector "digest-empty-string-64")

-      [(byte-array [90])]
-      (blake2b-vector "digest-0")
+    [(byte-array [90])
+     {:size 64}]
+    (blake2b-vector "digest-Z-64")

-      [(.getBytes "The quick brown fox jumps over the lazy dog")
-       {:key (.getBytes "This is a super secret key. Ssshh!")
-        :salt (.getBytes "0123456789abcdef")
-        :personal (.getBytes "fedcba9876543210")}]
-      (blake2b-vector "digest-with-key-salt-personal"))))
+    [(.getBytes "The quick brown fox jumps over the lazy dog")
+     {:size 64
+      :key (.getBytes "This is a super secret key. Ssshh!")
+      :salt (.getBytes "0123456789abcdef")
+      :personal (.getBytes "fedcba9876543210")}]
+    (blake2b-vector "digest-with-key-salt-personal-64")))

 (def blake2b-empty-args-variations
   "All of the different ways you could spell that you want the digest


sightings by observables handler

sightings by observables handler

--- src/ctia/stores/es/sighting.clj
+++ src/ctia/stores/es/sighting.clj
@@ -2,12 +2,14 @@
   (:require
    [schema.core :as s]
    [ctia.stores.es.crud :as crud]
+   [ctia.stores.es.query :as query]
    [ctia.schemas.sighting :refer [Sighting
                                   NewSighting
                                   StoredSighting
                                   realize-sighting]]
    [ctia.schemas.indicator :refer [Indicator]]
-   [ctia.lib.es.document :refer [search-docs]]))
+   [ctia.lib.es.document :refer [raw-search-docs
+                                 search-docs]]))

 (def handle-create-sighting (crud/handle-create :sighting StoredSighting))
@@ -22,9 +24,14 @@
   [state indicators]
   (let [indicator-ids (mapv :id indicators)]
     (handle-list-sightings state {:type "sighting"
-                                  [:indicators :indicator_id] indicator-ids})))
+                                  [:indicators :indicator_id]
+                                  indicator-ids})))

 (defn handle-list-sightings-by-observables
-  [state observables]
-  (handle-list-sightings state {:type "sighting"
-                                :observables observables}))
+  [{:keys [conn index]}  observables]
+
+  (raw-search-docs conn
+                   index
+                   mapping
+                   (query/sightings-by-observables-query observables)
+                   {}))


Uses BrowserSession component on oauth.client

--- src/cylon/oauth/impl/client.clj
+++ src/cylon/oauth/impl/client.clj
@@ -8,7 +8,7 @@
    [modular.bidi :refer (WebService)]
    [cylon.oauth.client :refer (AccessTokenGrantee UserIdentity solicit-access-token)]
    [cylon.authorization :refer (RequestAuthorizer)]
-   [cylon.session :refer (->cookie get-session assoc-session! create-session! cookies-response-with-session get-session-value get-session-id purge-session!)]
+   [cylon.session :refer (create-and-attach! get-data exists? ->cookie get-session assoc-session! create-session! cookies-response-with-session get-session-value get-session-id purge-session! remove! assoc-data!)]
    [ring.middleware.cookies :refer (wrap-cookies cookies-request cookies-response)]
    [ring.util.response :refer (redirect)]
    [ring.middleware.params :refer (wrap-params)]
@@ -126,8 +126,7 @@
                    :body (format "Something went wrong: status of underlying request %s" (:status at-resp))}

-                  (let [app-session-id (get-session-id req APP-SESSION-ID)
-                        original-uri (get-session-value req APP-SESSION-ID (:session-store this) :original-uri)
+                  (let [original-uri (get-data (:browser-session this) req :original-uri)
                         access-token (get (:body at-resp) "access_token")

                         ;; TODO If scope not there it is the same as
@@ -137,20 +136,23 @@
                         id-token (-> (get (:body at-resp) "id_token") str->jwt)]
                     (if (verify id-token "secret")
                       (do
+                        (assert original-uri (str "Failed to get original-uri from session " (-> this :browser-session :cookie-id)))
+
                         (infof "Verified id_token: %s" id-token)
-                        (assert original-uri (str "Failed to get original-uri from session " app-session-id))
-                        (assoc-session! (:session-store this) app-session-id :access-token access-token)
-
                         (infof "Scope is %s" scope)
-                        (assoc-session! (:session-store this) app-session-id :scope scope)
-
                         (infof "Claims are %s" (:claims id-token))
-                        (assoc-session! (:session-store this) app-session-id :open-id (-> id-token :claims))
+
+
+
+                        (assoc-data! (:browser-session this) req {:access-token access-token :scope scope :open-id (-> id-token :claims) })
+
+
+
                         (redirect original-uri))))))))))
       wrap-params)

      ::logout (fn [req]
-                (purge-session! (:session-store this) (get-session-id req APP-SESSION-ID))
+                (remove! (:browser-session this) req)
                 (if location-after-logout
                   (redirect location-after-logout)
                   {:status 200
@@ -162,8 +164,8 @@

   AccessTokenGrantee
   (get-access-token [this req]
-    (when-let [app-session-id (get-session-id req APP-SESSION-ID)]
-      (-> (get-session (:session-store this) app-session-id))))
+    (when (exists? (:browser-session this) req)
+      (get-data (:browser-session this) req)))

   (solicit-access-token [this req]
     (solicit-access-token this req []))
@@ -171,37 +173,37 @@
   ;; RFC 6749 4.1. Authorization Code Grant (A)
   (solicit-access-token [this req scopes]
     (let [original-uri (absolute-uri req)
-          ;; We need a session to store the original uri
-          session (create-session!
-                   (:session-store this)
-                   {:original-uri original-uri})
-          state (str (java.util.UUID/randomUUID))]
+          state (str (java.util.UUID/randomUUID))
+
+          ;; 4.1.1.  Authorization Request
+          response (let [loc (str
+                        (:authorize-uri this)
+                        (as-query-string {"response_type" "code" ; REQUIRED
+                                          "client_id" (:client-id this) ; REQUIRED
+                                        ; "redirect_uri" nil ; OPTIONAL (TODO)
+                                          "scope" (encode-scope
+                                                   (union (as-set scopes) ; OPTIONAL
+                                                          (:required-scopes this)))
+                                          "state" state ; RECOMMENDED to prevent CSRF
+                                          }))]
+               (debugf "Redirecting to %s" loc)
+               (redirect loc))
+
+         ]
+      ;; We need a session to store the original uri

       (expect-state this state)
-      ;; 4.1.1.  Authorization Request
-      (cookies-response-with-session
-       (let [loc (str
-                  (:authorize-uri this)
-                  (as-query-string {"response_type" "code" ; REQUIRED
-                                    "client_id" (:client-id this) ; REQUIRED
-                                    ; "redirect_uri" nil ; OPTIONAL (TODO)
-                                    "scope" (encode-scope
-                                             (union (as-set scopes) ; OPTIONAL
-                                                    (:required-scopes this)))
-                                    "state" state ; RECOMMENDED to prevent CSRF
-                                    }))]
-         (debugf "Redirecting to %s" loc)
-         (redirect loc))
-
-       APP-SESSION-ID
-       session)))
+      (create-and-attach! (:browser-session this) req response {:original-uri original-uri})
+
+
+      ))

   (expired? [_ req access-token] false)

   UserIdentity
   (get-claims [this req]
-    (let [app-session-id (get-session-id req APP-SESSION-ID)]
-      (-> (get-session (:session-store this) app-session-id) :open-id)))
+    (when (exists? (:browser-session this) req)
+      (get-data (:browser-session this) req :open-id)))

   ;; TODO Deprecate this!
   TempState
@@ -239,7 +241,7 @@
                      (s/optional-key :location-after-logout) s/Str
                      })
         map->WebClient)
-   [:session-store :client-registry]))
+   [ :client-registry :browser-session]))

 ;; But this isn't authorization - this is authentication
 ;; can you write?


add back json

add back json

--- src/luffer/worker.clj
+++ src/luffer/worker.clj
@@ -2,6 +2,7 @@
   (:gen-class)
   (:require [clojure.string :as str]
             [clj-http.client :as http]
+            [cheshire.core :as json]
             [spyscope.core]
             ;[clojure.tools.trace]
             [clojure.tools.cli :refer [parse-opts]]


Revert to older version of commons-codec for compatibility with compojure

--- src/such/random.clj
+++ src/such/random.clj
@@ -14,8 +14,7 @@
   "Returns a SHA-1 hash (encoded as a hex string) from the `prn` representation of the input.
    Use for collision avoidance when the highest security is not needed."
   [form]
-  (DigestUtils/sha1Hex (pr-str form)))
-
-
-
-
+  ;; Note: this is deprecated in later versions of commons.codec. However,
+  ;; we're using an old version for compatibility with Compojure.
+  ;; When compojure updates, we can use sha1Hex.
+  (DigestUtils/shaHex (pr-str form)))


CMR-1885 Update not-provided name in platforms

--- umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
@@ -3,6 +3,7 @@
   (:require [cmr.umm-spec.xml.gen :refer :all]
             [camel-snake-kebab.core :as csk]
             [cmr.umm-spec.xml-to-umm-mappings.serf :as utx]
+            [cmr.umm-spec.util :refer [without-default-value-of not-provided]]
             [clojure.set :as set]
             [clojure.string :as str]))

@@ -153,7 +154,7 @@
   "Creates SERF Source Name elements from a UMM-S Platforms mapping"
   [s]
   (for [platform (:Platforms s)
-           :when (not= (:ShortName platform) "Not provided")]
+           :when (not= (:ShortName platform) not-provided)]
        [:Source_Name
         [:Short_Name (:ShortName platform)]
         [:Long_Name (:LongName platform)]]))


Highlight events

Highlight events

Fixes #106

--- src/day8/re_frame/trace/styles.cljs
+++ src/day8/re_frame/trace/styles.cljs
@@ -156,6 +156,7 @@
     [(s/& ".trace--sub-run")
      [".trace--op" {:color dark-purple}]]
     [(s/& ".trace--event")
+     {:border-top [["1px" light-gray "solid"]]}
      [".trace--op" {:color common/event-color}]]
     [(s/& ".trace--render")
      [".trace--op" {:color dark-skyblue}]]


updating reps for example

updating reps for example

--- example/project.clj
+++ example/project.clj
@@ -8,10 +8,10 @@
                  [sablono "0.1.5"]
                  [crate "0.2.4"]
                  [jayq "2.4.0"]
-                 [figwheel "0.1.0-SNAPSHOT"]]
+                 [figwheel "0.1.2-SNAPSHOT"]]

   :plugins [[lein-cljsbuild "1.0.3"]
-            [lein-figwheel "0.1.0-SNAPSHOT"]]
+            [lein-figwheel "0.1.2-SNAPSHOT"]]

   :cljsbuild {
               :builds [{:id "example"


rewrote the functions as tests

rewrote the functions as tests

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -83,10 +83,11 @@
         feature-mat (map second tuples)]
     [[(logistic-beta-vector label-seq feature-mat 1e-8 1e-6 250)]]))

-(defn show-group-probabilities
-  "show calculated probabilities for each ecoregion grouping. generate
-  a separate coefficient vector for each ecoregion, and apply the
-  appropriate coefficient vector to each pixel.  Note that
+(deftest group-probabilities-test
+  "test that the classifier returns two alerts in this example for a
+  given ecoregion, constructed \"eco1\".  This method first calculates
+  a separate coefficient vector for each ecoregion, and then applies
+  the appropriate coefficient vector to each pixel.  Note that
   `?feat-training` is the feature set over the training period,
   whereas `?feat-update` is the feature set through the updated
   interval.  Here, for this example, the two feature sets are
@@ -98,26 +99,16 @@

   FOR THIS EXAMPLE: return the probabilities for the alerts identified
   for the sample ecoregion, eco1"
-  [n]
-  (let [src (create-sample-tap n)
-        beta-gen (<- [?eco ?beta]
-                     (src ?eco ?labels ?feat-training)
-                     (logistic-beta-wrap ?labels ?feat-training :> ?beta))]
-    (?<- (stdout)
-         [?eco ?prob]
-         (src ?eco ?labels ?feat-update)
-         (= ?eco "eco1")
-         (beta-gen ?eco ?beta)
-         (logistic-prob ?beta ?feat-update :> ?prob)
-         (> ?prob 0.5))))
-
-;; Will write tests soon when I understand how to NOT set off an
-;; infinite import loop...
-
-;; forma.classify.logistic-test> (show-group-probabilities 100)
-
-;; RESULTS
-;; -----------------------
-;; eco1	0.9999999999765928
-;; eco1	0.9999999999963644
-;; -----------------------
+  (fact
+   (let [src (create-sample-tap 100)
+         beta-gen (<- [?eco ?beta]
+                      (src ?eco ?labels ?feat-training)
+                      (logistic-beta-wrap ?labels ?feat-training :> ?beta))
+         alerts-query (<- [?eco ?prob]
+                          (src ?eco ?labels ?feat-update)
+                          (= ?eco "eco1")
+                          (beta-gen ?eco ?beta)
+                          (logistic-prob ?beta ?feat-update :> ?prob)
+                          (> ?prob 0.5))]
+     alerts-query => (produces [["eco1" 0.9999999999765928]
+                                ["eco1" 0.9999999999963644]]))))


REPL support for Closure libraries that follow classpath conventions

cljs.closure/source-for-namespace which is used by cljs.repl/load-namespace
now checks for a js file following classpath conventions before checking the
js dependency index

--- src/main/clojure/cljs/closure.clj
+++ src/main/clojure/cljs/closure.clj
@@ -518,18 +518,21 @@
       (let [relpath (str path ".cljc")]
         (if-let [cljc-res (io/resource relpath)]
           {:relative-path relpath :uri cljc-res}
-          (let [ijs (get-in @compiler-env [:js-dependency-index (str ns)])
-                relpath (or (:file ijs) (:url ijs))]
-            (if-let [js-res (and relpath
+          (let [relpath (str path ".js")]
+            (if-let [js-res (io/resource relpath)]
+              {:relative-path relpath :uri js-res}
+              (let [ijs (get-in @compiler-env [:js-dependency-index (str ns)])
+                   relpath (or (:file ijs) (:url ijs))]
+               (if-let [js-res (and relpath
                                  ;; try to parse URL, otherwise just return local
                                  ;; resource
                                  (or (and (util/url? relpath) relpath)
-                                     (try (URL. relpath) (catch Throwable t))
-                                     (io/resource relpath)))]
-              {:relative-path relpath :uri js-res}
-              (throw
-                (IllegalArgumentException.
-                  (str "Namespace " ns " does not exist"))))))))))
+                                   (try (URL. relpath) (catch Throwable t))
+                                   (io/resource relpath)))]
+                 {:relative-path relpath :uri js-res}
+                 (throw
+                   (IllegalArgumentException.
+                     (str "Namespace " ns " does not exist"))))))))))))

 (defn cljs-dependencies
   "Given a list of all required namespaces, return a list of


Little bit of a random test

Little bit of a random test

--- test/silly_image_store/store_test.clj
+++ test/silly_image_store/store_test.clj
@@ -21,8 +21,9 @@
         (is (nil? file)))))

   (testing "random image"
-    (let [file (random-image test-basedir)]
-      (is (= (.getPath file) "test/fixtures/test-all-the-things.jpg"))))
+    (let [file-path (.getPath (random-image test-basedir))]
+      (is (some #{file-path} ["test/fixtures/test-all-the-things.jpg"
+                              "test/fixtures/another-test.jpg"]))))

   (testing "listing images"
     (is (= (list-images test-basedir) ["another-test.jpg" "test-all-the-things.jpg"]))))


Fix typo

Fix typo

--- src/lcmap/aardvark/config.clj
+++ src/lcmap/aardvark/config.clj
@@ -12,7 +12,7 @@

   Schema is used to coerce string values into expected types and
   ensure the overall config structure and presence of values.
-n
+
   To retrieve configuration values, require this namespace and
   use `(get-in)` to retrieve expected values. Care is taken to
   provide data in the shape expected by libraries, for example,


Updated ring-server dependency to 0.2.3

Updated ring-server dependency to 0.2.3

--- src/leiningen/ring/server.clj
+++ src/leiningen/ring/server.clj
@@ -29,7 +29,7 @@
   [project options]
   (let [project (update-in project [:ring] merge options)]
     (eval-in-project
-     (update-in project [:dependencies] conj ['ring-server "0.2.2"])
+     (update-in project [:dependencies] conj ['ring-server "0.2.3"])
      `(ring.server.leiningen/serve '~project)
      (load-namespaces
       'ring.server.leiningen


Check Bonjour type in addition to name

Check Bonjour type in addition to name

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -54,14 +54,16 @@
         service-listener
         (reify ServiceListener
           (serviceAdded [_ service-event]
-            (let [name (.getName service-event)]
-              (when (is-ambly-bonjour-name? name)
-                (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
+            (let [type (.getType service-event)
+                  name (.getName service-event)]
+              (when (and (= reg-type type) (is-ambly-bonjour-name? name))
+                (.requestServiceInfo mdns-service type name 1))))
           (serviceRemoved [_ service-event]
             (swap! name-endpoint-map dissoc (.getName service-event)))
           (serviceResolved [_ service-event]
-            (let [name (.getName service-event)]
-              (when (is-ambly-bonjour-name? name)
+            (let [type (.getType service-event)
+                  name (.getName service-event)]
+              (when (and (= reg-type type) (is-ambly-bonjour-name? name))
                 (let [entry {name (let [info (.getInfo service-event)]
                                     {:address (.getAddress info)
                                      :port    (.getPort info)})}]


Remove spurious requires

Remove spurious requires

--- src/om_chat/core.cljs
+++ src/om_chat/core.cljs
@@ -3,8 +3,6 @@
   (:require [goog.dom :as gdom]
             [om.next :as om :refer-macros [defui]]
             [om.dom :as dom]
-            [om-chat.components.root :as root]
-            [om-chat.parser :as p]
             [cljs-time.core :as dt]
             [cljs-time.coerce :as dt2]))

@@ -132,12 +130,18 @@
                      (thread-section)
                      (message-section)))))

+(defmulti read om/dispatch)
+(defmethod read :default
+  [{:keys [state] :as env} k _]
+  (let [st @state]
+    (if (contains? st k)
+      {:value (get st k)}
+      {:remote true})))
+
 (def reconciler
   (om/reconciler {:state {:threads (reduce threads [] raw-data)}
-                  :parser (om/parser {:read p/read :mutate p/mutate})}))
+                  :parser (om/parser {:read read})}))

 (om/add-root! reconciler
-              root/ChatApp
+              ChatApp
               (gdom/getElement "app"))
-
-(om/transact! reconciler `[(thread/select {:thread/id "t_3"}) :threads])


Herokuizing

Herokuizing

--- src/pairwell/main.clj
+++ src/pairwell/main.clj
@@ -22,5 +22,5 @@

 (defn -main [& [port]]
   (when port
-    (alter-var-root #'system assoc :port port))
+    (alter-var-root #'system assoc :port (Integer. port)))
   (alter-var-root #'system start))


Remove whitespace

Remove whitespace

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -35,7 +35,7 @@
         (swap! screen assoc
                :total-time 0
                :delta-time 0
-               :create-renderer #(swap! screen assoc  :renderer (renderer %))
+               :create-renderer #(swap! screen assoc :renderer (renderer %))
                :create-camera #(swap! screen assoc :camera (camera %)))
         (execute on-show))
       (render [delta-time]


Fix various non-idiomatic or unnecessarily-complicated implementations

--- src/useful.clj
+++ src/useful.clj
@@ -38,40 +38,32 @@
 (defn include?
   "Check if val exists in coll."
   [val coll]
-  (some (partial = val) coll))
+  (some #{val} coll))

 (defn extract
   "Extracts the first item that matches pred from coll, returning a vector of that item
    followed by coll with the items removed."
   [pred coll]
-  (loop [head ()
-         tail (seq coll)]
-    (let [item (first tail)
-          tail (next tail)]
-      (if (or (nil? tail) (pred item))
-        [item (into tail head)]
-        (recur (conj head item) tail)))))
+  (let [[head [item & tail]] (split-with (complement pred) coll)]
+    [item (concat head tail)]))

 (defn separate
   "Split coll into two sequences, one that matches pred and one that doesn't. Unlike, the
   version in clojure.contrib.seq-utils, this is not lazy, but pred is only called once per item."
   [pred coll]
-  (loop [tail (seq coll)
-         yes () no ()]
-    (if (nil? tail)
-      [(reverse yes) (reverse no)]
-      (let [item (first tail)
-            tail (next tail)]
-        (if (pred item)
-          (recur tail (conj yes item) no)
-          (recur tail yes (conj no item)))))))
+  (reduce (fn [[yes no] item]
+            (if (pred item)
+              [(conj yes item) no]
+              [yes (conj no item)]))
+          [[] []]
+          coll))

 (defmacro if-ns [ns-reference then-form & [else-form]]
-  "Try to load a namespace reference. If sucessful, evaluate then-form otherwise evaluate else-form."
+  "Try to load a namespace reference. If successful, evaluate then-form otherwise evaluate else-form."
   `(try (ns ~(ns-name *ns*) ~ns-reference)
         (eval '~then-form)
         (catch Exception e#
-          (when (not (instance? java.io.FileNotFoundException e#))
+          (when-not (instance? java.io.FileNotFoundException e#)
             (println "Error loading" '~ns-reference (.getMessage e#)))
           (eval '~else-form))))

@@ -195,9 +187,7 @@
   "Returns a lazy sequence of vectors of corresponding items from each collection.
    Stops when the shortest collection runs out."
   [& colls]
-  (partition
-   (count colls)
-   (apply interleave colls)))
+  (apply map vector colls))

 (defn find-with
   "Returns the val corresponding to the first key where (pred key) returns true."
@@ -205,9 +195,9 @@
   (last (first (filter (comp pred first) (zip keys vals)))))

 (defn filter-keys-by-val
-  "Returns a keys of map for which (pred value) returns true."
+  "Returns all keys in map for which (pred value) returns true."
   [pred map]
-  (if map
+  (when map
     (for [[key val] map :when (pred val)] key)))

 (defn remove-keys-by-val
@@ -218,7 +208,7 @@
 (defn filter-vals
   "Returns a map that only contains values where (pred value) returns true."
   [pred map]
-  (if map
+  (when map
     (select-keys map (filter-keys-by-val pred map))))

 (defn remove-vals
@@ -261,7 +251,7 @@
   and v is the new value and returns a new nested structure. The associative structure
   can have transients in it, but if any levels do not exist, non-transient hash-maps will
   be created."
-  [m [k & ks :as keys] v]
+  [m [k & ks] v]
   (let [assoc (if (instance? clojure.lang.ITransientCollection m) assoc! assoc)]
     (if ks
       (assoc m k (assoc-in! (get m k) ks v))


Try dropping the proof, as the audience didn't strongly respond.

--- src/kolmogorov_music/kolmogorov.clj
+++ src/kolmogorov_music/kolmogorov.clj
@@ -134,34 +134,6 @@

-;;;;;;;;;;;;;;;;;;;;;
-;;; Drawing Hands ;;;
-;;;;;;;;;;;;;;;;;;;;;
-
-(defn complexity
-  "An impossible function that determines the Kolmogorov complexity of any value."
-  [string]
-  (->> string (map int) (reduce + 0)))
-
-(defn enterprise
-  "Calculate the shortest string that is more complicated than itself."
-  []
-  (let [source (repl/source-fn 'enterprise)]
-     (->> (library-of-babel)
-       (drop-while #(<= (complexity %) (result-length source)))
-       first)))
-
-
-
-
-
-
-
-
-
-
-
-
 ;;;;;;;;;;;;;;;;
 ;;; Contact ;;;;
 ;;;;;;;;;;;;;;;;


fix ns info merging regression

fix ns info merging regression

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -1903,8 +1903,7 @@
               (let [ns-info' (get-in @env/*compiler* [::namespaces name])]
                 (if (pos? (count ns-info'))
                   (let [merge-keys
-                        [:name :doc :excludes :use-macros :require-macros
-                         :uses :requires :imports]]
+                        [:use-macros :require-macros :uses :requires :imports]]
                     (merge
                       ns-info'
                       (merge-with merge


CLJS-1331: Regex literal emits invalid JS

Regex emission in bootstrapped ClojureScript
is simple and straightforward.

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -230,10 +230,10 @@
   (if (= "" (str x))
     (emits "(new RegExp(\"\"))")
     (let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))]
-      (emits \/
-        #?(:clj (.replaceAll (re-matcher #"/" pattern) "\\\\/")
-           :cljs (string/replace pattern #"/" "\\\\/"))
-        \/ flags))))
+      #?(:clj  (emits \/
+                 (.replaceAll (re-matcher #"/" pattern) "\\\\/")
+                 \/ flags)
+         :cljs (emits pattern)))))

 (defn emits-keyword [kw]
   (let [ns   (namespace kw)


added func

added func

--- src/main/clojure/czlab/basal/io.clj
+++ src/main/clojure/czlab/basal/io.clj
@@ -17,6 +17,7 @@
             [clojure.string :as cs]
             [clojure.edn :as edn]
             [czlab.basal.util :as u]
+            [czlab.basal.log :as l]
             [czlab.basal.core :as c]
             [czlab.basal.indent :as in])

@@ -549,15 +550,16 @@
   (let [fp (io/file dir fname)]
     (if (file-read? fp) (XData. fp false))))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn save-file
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn spit-file
   "Save a file to a directory"

-  ([dir fname stuff]
-   (save-file dir fname stuff false))
-
-  ([dir fname stuff del?]
-   (let [fp (io/file dir fname)
+  ([file stuff]
+   (spit-file file stuff false))
+
+  ([file stuff del?]
+   (let [fp (io/file file)
          ^XData
          in (if (c/is? XData stuff)
               stuff (XData. stuff false))]
@@ -573,7 +575,19 @@
          (Files/move (.. in fileRef toPath) (.toPath fp) opts)
          ;;since file has moved, update stuff
          (.setDeleteFlag in false)
-         (.reset in nil))))))
+         (.reset in nil)))
+     (l/info "FFFFFFFFF = %s" fp)
+     fp)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn save-file
+  "Save a file to a directory"
+
+  ([dir fname stuff]
+   (save-file dir fname stuff false))
+
+  ([dir fname stuff del?]
+   (spit-file (io/file dir fname) stuff del?)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn change-content


Dynamic vars were not properly recreated, fix #9

--- src/main/clojure/powderkeg/core.clj
+++ src/main/clojure/powderkeg/core.clj
@@ -133,8 +133,9 @@
                        (some-> parent-bc .value force) ; that's how env changes are chained
                        (doseq [[ns-sym vars] vars
                                :let [ns (create-ns ns-sym)]
-                               [sym [m v]] vars]
-                         (intern ns (with-meta sym m) v))))))]
+                               [sym [{:keys [dynamic] :as m} v]] vars]
+                         (doto ^clojure.lang.var (intern ns (with-meta sym m) v)
+                           (.setDynamic (boolean dynamic))))))))]
         #(force (.value bc)))
       (let [bc @@last-broadcast]
         #(force (.value bc))))))