Add wrap-with-return to block-fn

Add wrap-with-return to block-fn

--- src/luaclj/core.clj
+++ src/luaclj/core.clj
@@ -95,17 +95,20 @@
                                     [ALL #(= (safe-some-> %1 first) :local)]
                                     args)
         ;local-var-init-statements (get-var-init-statements :local args)
+        wrap-with-return (fn [arg]
+                           `(when (not :returned?) ~arg))
         transform-fn (fn [arg]
                        (cond (= :local (safe-some-> arg first))
                          `([:local ~(third arg)] ~(fourth arg))
-                         :else `(~'_  ~arg)))
+                         :else `(~'_  ~(wrap-with-return arg))))
         r (cond (seq local-var-init-statements)
             `(let-mutable ~(vec (mapcat identity
                                         (transform ALL transform-fn args))))
             (next args)
-            `(do ~@args)
-            :else (first args))]
+            `(do ~@(map wrap-with-return args))
+            :else (wrap-with-return (first args)))]
     (println "block-fn return:" r)
+    ;`(when (not :returned?) ~r)
     r
     ))

@@ -243,15 +246,15 @@

 (pprint (lua-parser (slurp "resources/test/basic1.lua")))
 (proteus/let-mutable
-  [G__19303 nil G__19304 false
-   g 55;nil
-   (do (cond true
-             (proteus/let-mutable
-               [l "local_var"
-                luaclj.core/_ (set! l "local_var_modified")
-                luaclj.core/_ (do (set! G__19304 true) (println "setting:" l) (set! G__19303 l))]))
-       (set! g "global_var") (do (set! G__19304 true) (println "g:" g) (set! G__19303 g)))]
-  G__19303)
+  [G__21415 nil
+   G__21416 false
+   l nil g nil
+   _ (do
+       (clojure.core/when (clojure.core/not G__21416)
+         (cond true (do (clojure.core/when (clojure.core/not G__21416) set!) (clojure.core/when (clojure.core/not G__21416) (set! l "local_var_modified")) (do (set! G__21416 true) (set! G__21415 l)))))
+       (clojure.core/when (clojure.core/not G__21416) (set! g "global_var"))
+       (do (set! G__21416 true) (set! G__21415 g)))]
+  G__21415)
 (eval (insta/transform transform-map (lua-parser (slurp "resources/test/basic1.lua"))))
   (try (pprint (insta/transform transform-map (lua-parser (slurp "resources/test/basic1.lua"))))
        (catch Exception ex (clojure.stacktrace/print-stack-trace ex)))


working on subexpres

working on subexpres

--- src/bluebell/utils/core.clj
+++ src/bluebell/utils/core.clj
@@ -386,3 +386,24 @@
   (let [init (conform-or-error ::with-value-init init)]
     (with-value-sub []
       init updates)))
+
+
+(def default-subexpr-cfg (merge default-traverse-cfg {:visit identity}))
+
+(defn add-subexpressions [result lookup k]
+  (assoc result k true))
+
+(defn compute-subexpressions-sub [analyzed]
+  (reduce (fn [r k]
+            (add-subexpressions r analyzed k))
+          {}
+          (keys analyzed)))
+
+(defn compute-subexpressions
+  ([expr]
+   (compute-subexpressions expr {}))
+  ([expr cfg]
+   (compute-subexpressions-sub
+    (first
+     (traverse-postorder-cached
+      {} expr (merge default-subexpr-cfg cfg))))))


add tagged literal and syntax entry types for docset

--- src/cljs_api_gen/docset.clj
+++ src/cljs_api_gen/docset.clj
@@ -46,6 +46,8 @@
    "function"            "Function"
    "special form"        "Statement" ;; <-- Pending "Special Form"
    "special form (repl)" "Statement" ;;     (avaiable in next Dash version)
+   "tagged literal"      "Tag"
+   "syntax"              "Operator"  ;; <-- Pending "Syntax"
    })

 (defn assert-reqs!


Add case-stasis meta-error

Add case-stasis meta-error

--- src/clojush/meta_errors.clj
+++ src/clojush/meta_errors.clj
@@ -187,6 +187,22 @@
                   (map vector (first hist) (second hist)))
           0
           1)))))
+
+(defn case-stasis-meta-error
+  [ind evaluated-population argmap]
+  (if (not (:print-history argmap))
+    (throw
+     (Exception.
+      ":print-history must be true for :case-stasis"))
+    (if (empty? (rest (:history ind)))
+      (vec (repeat (count (:errors ind)) 0))
+      (vec (for [case-history (apply map list (:history ind))]
+             (if (or (zero? (first case-history))
+                     (and (not (zero? (second case-history)))
+                          (not (= (first case-history)
+                                  (second case-history)))))
+               0
+               1))))))

 (defn non-improvement-meta-error
   [ind evaluated-population argmap]


Change name of interface for story querying.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -8,8 +8,8 @@

 (declare types name-into-objs extract-by-class get-story-ctx)

-(defprotocol Explorable
   (get-current-room [this])
+(defprotocol Queryable
   (get-all-items [this])
   (get-item [this name]))

@@ -18,9 +18,9 @@
   (look [this arguments]))

 (defrecord Story [player rooms]
-  Explorable
   (get-current-room [this]
     (first (filter (fn [x] (= (:order x) (:current-room player))) rooms)))
+  Queryable
   (get-all-items [this]
     (concat (map (fn [x] (:items x)) rooms)))
   (get-item [this name]


Simplify kmg.domain/recommendation-ids

Simplify kmg.domain/recommendation-ids

As we all know, parentheses are evil. Let's get rid of some of them and make the code more readable!

--- src/kmg/domain.clj
+++ src/kmg/domain.clj
@@ -56,7 +56,7 @@
 (defn recommendation-ids [db user]
   (let [recs (recommendations-for-user db user)
         completed (set (recommendations-completed-by-user db user))]
-    (filter #(not (contains? completed %)) recs)))
+    (keep completed recs)))

 ;; (recommendation-ids (db) "user1")
 ;; (recommendation-ids (db) "user2")


better doc for defs with implicit type parameters

--- src/latte/core.clj
+++ src/latte/core.clj
@@ -105,23 +105,23 @@
                  explicit-def-name (symbol (str def-name "-def"))]
                 `(do
                    (definition ~explicit-def-name ~(str "This is an explicit variant of [[" def-name "]].") ~new-params ~body)
-                   ~(gen-type-parameters-defimplicit def-name doc explicit-def-name implicit-types new-params body)
-                   [:defined :term (quote ~def-name)]
-                   ))
-            ;; no implicit parmeter types from here...
-            (let [[status definition] (handle-term-definition def-name params body)]
-          (when (= status :ko)
-            (throw (ex-info "Cannot define term." {:name def-name, :error definition})))
-          ;;{
-          ;;  - Second, after some checks, we register the definition in the currently active namespace (i.e. `*ns*`).
-          ;;}
-          (let [quoted-def# definition]
-            `(do
-               (def ~def-name ~quoted-def#)
-               (alter-meta! (var ~def-name)  (fn [m#] (assoc m#
-                                                             :doc (mk-def-doc "Definition" (quote ~body) ~doc)
-                                                             :arglists (list (quote ~params)))))
-               [:defined :term (quote ~def-name)]))))))))
+                   ~(gen-type-parameters-defimplicit def-name "Definition" doc explicit-def-name implicit-types params new-params body)
+                   (alter-meta! (var ~def-name) update-in [:arglists] (fn [_#] (list (quote ~params))))
+                   [:defined :term (quote ~def-name)]))
+          ;; no implicit parmeter types from here...
+          (let [[status definition] (handle-term-definition def-name params body)]
+            (when (= status :ko)
+              (throw (ex-info "Cannot define term." {:name def-name, :error definition})))
+            ;;{
+            ;;  - Second, after some checks, we register the definition in the currently active namespace (i.e. `*ns*`).
+            ;;}
+            (let [quoted-def# definition]
+              `(do
+                 (def ~def-name ~quoted-def#)
+                 (alter-meta! (var ~def-name)  (fn [m#] (assoc m#
+                                                               :doc (mk-def-doc "Definition" (quote ~body) ~doc)
+                                                               :arglists (list (quote ~params)))))
+                 [:defined :term (quote ~def-name)]))))))))

 ;;{
 ;; The following function generates a `defimplicit` form that (if successful) synthesizes
@@ -130,68 +130,23 @@
 ;; is found).
 ;;}

-(comment
-
-  ;; example of a definition with autoimplicit type arguments
-
-  (definition ex
-    "existential"
-    [[P (==> ?T :type)]]
-    (forall [α :type]
-            (==> (forall [x T] (==> (P x) α))
-                 α)))
-
-  ;; should produce (1) the following definiion
-
-  (definition ex-def
-    "explicit version of [[ex]]"
-    [[T :type] [P (==> T :type)]]
-    (forall [α :type]
-            (==> (forall [x T] (==> (P x) α))
-                 α)))
-
-  ;; this is obtained from the following structure
-  '[[?T]]
-
-  ;; and (2) the following implicit
-
-  (defimplicit ex
-    "existential" ;; same doc as what would create the definition
-    [def-env ctx [P-term P-type]]
-    (let [[T _] (decompose-impl-type P-ty)]
-      (#'ex-def T P-ty)))
-
-  ;; this is obtained from the following structure
-  '[[P ['==> T _]]]
-
-  ;; and the generation environment
-  {'==> decompose-impl-type}
-)
-
 (defn ^:no-doc gen-type-parameters-defimplicit
   "Generate the defimplicit for definitions with implicit type parameters."
-  [def-name doc explicit-def-name implicit-types new-params body]
+  [def-name def-kind doc explicit-def-name implicit-types real-params explicit-params body]
   (let [def-env-var (gensym "def-env")
         ctx-var (gensym "ctx")
-        ndoc (mk-def-doc "Definition" body (str doc "\n see [[" explicit-def-name "]]"))
+        ndoc (mk-def-doc def-kind body (str doc "\nsee [[" explicit-def-name "]]"))
         [targs defparams] (reduce (fn [[targs defparams] [param param-ty]]
                                     (if (contains? implicit-types param)
                                       [targs defparams]
                                       (let [param-ty-var (gensym (str param "-ty"))]
                                         [(conj targs [param-ty-var param-ty])
                                          (conj defparams [(gensym (str param "-term")) param-ty-var])])))
-                                  [[] []] new-params)
-        _ (println "targs=" targs)
-        _ (println "defparams=" defparams)
+                                  [[] []] explicit-params)
         [remaining-implicit-types lt-clauses]
         (reduce (fn [[itypes lt-clauses] param]
-                  (println "==== param = " param)
-                  (println "itypes=" itypes)
-                  (println "lt-clauses=" lt-clauses)
                   (let [[itypes' lt-clause]
-                        (u/fetch-implicit-type-parameter-handler itypes def-env-var ctx-var param)
-                        _ (println "itypes'=" itypes')
-                        _ (println "lt-cause=" lt-clause)]
+                        (u/fetch-implicit-type-parameter-handler itypes def-env-var ctx-var param)]
                     [itypes' (if (nil? lt-clause)
                                lt-clauses
                                (conj lt-clauses lt-clause))])) [implicit-types []] targs)]
@@ -263,13 +218,13 @@
 ;; of other `kind` of statements such as theorems or axioms.
 ;;}

-(defn ^:no-doc mk-def-doc [kind content explanation]
+(defn ^:no-doc mk-def-doc
+  [kind content explanation]
   (str "\n```\n"
        (with-out-str
          (pp/pprint content))
        "```\n**" kind "**: "
        (or explanation "")))
-

 ;;{
 ;; ## Theorems, lemmas and axioms
@@ -686,11 +641,9 @@

 (s/def ::iparam any?) ;; (s/tuple symbol? symbol?))

-(defn ^:no-doc mk-impl-doc [name params explanation]
-  (str "\n```\n"
-       "(" name " " (clojure.string/join " " params) ")"
-       "```\n\n"
-       (or explanation "")))
+(defn ^:no-doc mk-impl-doc [name explanation]
+  ;; XXX: everything in the explanation ?
+  explanation)

 (defmacro defimplicit
   [& args]
@@ -702,9 +655,7 @@
             {def-env :def-env ctx :ctx params :params} header]
         (when (defenv/registered-definition? def-name)
           (println "[Warning] redefinition as implicit"))
-        (let [metadata (merge (meta &form) {:doc (mk-impl-doc def-name (mapv #(if (vector? %)
-                                                                                (first %)
-                                                                                %) params) doc)})]
+        (let [metadata (merge (meta &form) {:doc (mk-impl-doc def-name doc)})]
           `(do
              (def ~def-name (defenv/->Implicit '~def-name (fn [~def-env ~ctx ~@params] ~@body)))
              (alter-meta! (var ~def-name) #(merge % (quote ~metadata)))


debugging

debugging

--- src/latte/prop.clj
+++ src/latte/prop.clj
@@ -529,25 +529,52 @@
     (assume [H2 A]
       (have <a1> (or A B)
             :by (or-intro-left H2 B))
+      ;;[:print '<a1> {}]
       (have <a> (or (or A B) C)
-            :by (or-intro-left <a1> C)))
+            :by (or-intro-left <a1> C))
+      ;;[:print '<a> {:norm true}]
+      ;;[:print-type '<a> {}]
+      )
+    ;;[:print '<a1> {}]
+    ;;[:print '<a> {:norm true}]
+    ;;[:print-type '<a> {}]
     (assume [H3 (or B C)]
       (assume [H4 B]
         (have <b1> (or A B)
               :by (or-intro-right A H4))
+        ;;[:print '<b1> {}]
         (have <b> (or (or A B) C)
-              :by (or-intro-left <b1> C)))
+              :by (or-intro-left <b1> C))
+        ;;[:print '<b> {:norm true}]
+        ;;[:print-type '<b> {}]
+        )
+      ;;[:print '<b1> {}]
+      ;;[:print '<b> {:norm true}]
+      ;;[:print-type '<b> {}]
       (assume [H5 C]
         (have <c> (or (or A B) C)
-              :by (or-intro-right (or A B) H5)))
+              :by (or-intro-right (or A B) H5))
+        ;;[:print '<c> {:norm true}]
+        ;;[:print-type '<c> {}]
+        )
+      ;;[:print '<c> {:norm true}]
+      ;;[:print-type '<c> {}]
       (have <d> _
             :by (or-elim H3 (or (or A B) C)
-                         <b> <c>)))
+                         <b> <c>))
+      ;; [:print '<d> {:norm true}]
+      ;;[:print-type '[(or-elim-thm B C) H3] {:norm true}]
+      ;;[:print-type '<d> {:norm true}]
+      )
+    [:print-type '<d> {:norm true}]
     (have <e> _
           :by (or-elim H1 (or (or A B) C)
-                        <a> <d>)))
-  [:print '<e> {}]
-  [:print-type '<e> {}]
+                       <a> <d>))
+    [:print '<e> {:delta false, :norm true}]
+    [:print-type '<e> {:norm true}]
+    )
+  ;;[:print '<e> {}]
+  ;;[:print-type '<e> {:norm true}]
   (qed <e>))

 (defimplicit or-assoc


iff-trans special

iff-trans special

--- src/latte/prop.clj
+++ src/latte/prop.clj
@@ -93,7 +93,7 @@
           (throw (ex-info "Type in the middle mismatch" {:special 'latte.prop/impl-trans%
                                                          :left-rhs-type B
                                                          :right-lhs-type B'})))
-        [(list #'iff-trans A B C) impl-term1 impl-term2])))))
+        [[(list #'iff-trans A B C) impl-term1] impl-term2])))))

 (definition absurd
   "Absurdity."
@@ -652,6 +652,16 @@
     (have b (==> A B) :by (a H))
     (qed b)))

+(defn decompose-iff-type
+  [def-env ctx t]
+  (let [[status L R] (decompose-and-type def-env ctx t)]
+    (if (= status :ko)
+      [:ko nil nil]
+      (let [[status A B] (decompose-impl-type def-env ctx L)]
+        (if (= status :ko)
+          [:ko nil nil]
+          [:ok A B])))))
+
 (defspecial iff-elim-if%
   "Left (if) elimination for `<=>`, a special version of [[iff-elim-if]]."
   [def-env ctx iff-term]
@@ -661,9 +671,9 @@
                                            :term iff-term
                                            :from ty}))
       (do
-        (let [[status A B] (decompose-and-type def-env ctx ty)]
+        (let [[status A B] (decompose-iff-type def-env ctx ty)]
           (if (= status :ko)
-            (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-elim-if%
+            (throw (ex-info "Not an `iff`-type." {:special 'latte.prop/iff-elim-if%
                                                   :term iff-term
                                                   :type ty}))
             [(list #'iff-elim-if A B) iff-term]))))))
@@ -693,9 +703,9 @@
                                            :term iff-term
                                            :from ty}))
       (do
-        (let [[status A B] (decompose-and-type def-env ctx ty)]
+        (let [[status A B] (decompose-iff-type def-env ctx ty)]
           (if (= status :ko)
-            (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-elim-only-if%
+            (throw (ex-info "Not an `iff`-type." {:special 'latte.prop/iff-elim-only-if%
                                                   :term iff-term
                                                   :type ty}))
             [(list #'iff-elim-only-if A B) iff-term]))))))
@@ -725,16 +735,12 @@
       (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-sym%
                                            :term iff-term
                                            :from ty})))
-    (let [[status C _] (decompose-and-type def-env ctx ty)]
+    (let [[status A B] (decompose-iff-type def-env ctx ty)]
       (when (= status :ko)
-        (throw (ex-info "Not an `and`-type." {:special 'latte.prop/iff-sym%
+        (throw (ex-info "Not an `iff`-type." {:special 'latte.prop/iff-sym%
                                               :term iff-term
                                               :type ty})))
-      (when-not (stx/prod? C)
-        (throw (ex-info "Not a product type." {:special 'latte.prop/iff-sym%
-                                               :term C})))
-      (let [[_ [A _] B] C]
-        [(list #'iff-sym A B) iff-term]))))
+      [(list #'iff-sym A B) iff-term])))

 (defthm iff-trans
   "Transitivity of logical equivalence."
@@ -760,3 +766,40 @@
     (qed k)))

+(defspecial iff-trans%
+  "Transitivity of `<=>`, a special version of [[iff-trans]]."
+  [def-env ctx iff-term1 iff-term2]
+  (let [[status ty1] (ty/type-of-term def-env ctx iff-term1)]
+    (when (= status :ko)
+      (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-trans%
+                                           :term iff-term1
+                                           :from ty1})))
+    (let [[status ty2] (ty/type-of-term def-env ctx iff-term2)]
+      (when (= status :ko)
+        (throw (ex-info "Cannot type term." {:special 'latte.prop/iff-trans%
+                                             :term iff-term2
+                                             :from ty2})))
+      (let [[status A B] (decompose-iff-type def-env ctx ty1)]
+        (when (= status :ko)
+          (throw (ex-info "Not an `iff`-type." {:special 'latte.prop/iff-trans%
+                                                :term iff-term1
+                                                :type ty1})))
+        (let [[status C D] (decompose-iff-type def-env ctx ty2)]
+          (when (= status :ko)
+            (throw (ex-info "Not an `iff`-type." {:special 'latte.prop/iff-trans%
+                                                  :term iff-term2
+                                                  :type ty2})))
+          (cond
+            (norm/beta-eq? def-env ctx B C)
+            [[(list #'iff-trans A B D) iff-term1] iff-term2]
+            ;; allow a symmetry
+            (norm/beta-eq? def-env ctx B D)
+            [[(list #'iff-trans A B C) iff-term1] iff-term2]
+            :else
+            (throw (ex-info "Type in the middle mismatch"
+                            {:special 'latte.prop/iff-trans%
+                             :left-lhs-type B
+                             :right-lhs-type C
+                             :right-rhs-type D}))))))))
+
+


Update user settings api tokens subpage

Update user settings api tokens subpage

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -5,6 +5,7 @@
   (:require [frontend.async :refer [raise!]]
             [frontend.components.pieces.button :as button]
             [frontend.components.pieces.card :as card]
+            [frontend.components.pieces.form :as form]
             [frontend.components.pieces.icon :as icon]
             [frontend.components.pieces.modal :as modal]
             [frontend.components.pieces.table :as table]
@@ -65,52 +66,52 @@
             new-user-token (get-in app state/new-user-token-path)]
         (html
          [:div.account-settings-subpage
-          [:legend "API Tokens"]
-          [:div.api-item
-           [:p
-            "Create and revoke API tokens to access this account's details using our API."
-            [:br]
-            "Apps using these tokens can act as you, and have full read- and write-permissions!"]
-
-           [:form
-            [:input#api-token
-             {:required  true
-              :name      "label",
-              :type      "text",
-              :value     (str new-user-token)
-              :on-change #(utils/edit-input owner state/new-user-token-path %)}]
-            [:label {:placeholder "Token name"}]
-            (button/managed-button
-             {:loading-text "Creating..."
-              :failed-text "Failed to add token"
-              :success-text "Created"
-              :on-click #(create-token! new-user-token)}
-             "Create New Token")]
-
-           [:div.api-item
-            (when (seq tokens)
-              (om/build table/table
-                        {:rows tokens
-                         :key-fn :token
-                         :columns [{:header "Label"
-                                    :cell-fn :label}
-
-                                   {:header "Token"
-                                    :type :shrink
-                                    :cell-fn :token}
-
-                                   {:header "Created"
-                                    :type :shrink
-                                    :cell-fn (comp datetime/medium-datetime js/Date.parse :time)}
-
-                                   {:header "Remove"
-                                    :type :shrink
-                                    :cell-fn
-                                    (fn [token]
-                                      (table/action-button
-                                       "Remove"
-                                       (icon/cancel-circle)
-                                       #(raise! owner [:api-token-revocation-attempted {:token token}])))}]}))]]])))))
+          [:legend "Personal API Tokens"]
+          (card/titled {:title "API Tokens"
+                        :action (button/managed-button
+                                  {:loading-text "Creating..."
+                                   :failed-text "Failed to add token"
+                                   :success-text "Created"
+                                   :kind :primary
+                                   :size :medium
+                                   :on-click #(create-token! new-user-token)}
+                                  "Create New Token")}
+            (html
+              [:div
+               [:div.api-item
+                [:p
+                 "Tokens you have generated that can be used to access the CircleCI API."
+                 [:br]
+                 "Apps using these tokens can act as you and have full read- and write-permissions!"]
+
+                 ;; FIXME: Use modal pattern like SSH keys to add and remove tokens
+                 (om/build form/text-field {:label "Token name"
+                                            :value (str new-user-token)
+                                            :on-change #(utils/edit-input owner state/new-user-token-path %)})
+                [:div.api-item
+                 (when (seq tokens)
+                   (om/build table/table
+                             {:rows tokens
+                              :key-fn :token
+                              :columns [{:header "Label"
+                                         :cell-fn :label}
+
+                                        {:header "Token"
+                                         :type :shrink
+                                         :cell-fn :token}
+
+                                        {:header "Created"
+                                         :type :shrink
+                                         :cell-fn (comp datetime/medium-datetime js/Date.parse :time)}
+
+                                        {:header "Remove"
+                                         :type :shrink
+                                         :cell-fn
+                                         (fn [token]
+                                           (table/action-button
+                                            "Remove"
+                                            (icon/cancel-circle)
+                                            #(raise! owner [:api-token-revocation-attempted {:token token}])))}]}))]]]))])))))

 (def available-betas


Parse a production properly when importing from ABACUS

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -64,7 +64,8 @@
                 :periodical_number (when (= production_type "periodical") idVorstufe)}))))

 (defn read-file
-  "Read an export file from ABACUS and return a map with all the data"
+  "Read an export file from ABACUS and return a map with all the data,
+  i.e. a production"
   [file]
   (let [zipper (-> file io/file xml/parse zip/xml-zip)]
     (->>
@@ -72,7 +73,8 @@
            :let [val (apply xml1-> zipper (concat root-path path))]]
        [key val])
       (into {})
-      clean-raw-production)))
+      clean-raw-production
+      prod/parse)))

 (defn import-new-production
   "Import a new production from file `f`"


Extract the login bar into a separate function

--- src/mdr2/layout.clj
+++ src/mdr2/layout.clj
@@ -1,5 +1,13 @@
 (ns mdr2.layout
   (:require [hiccup.page :refer [html5 include-css]]))
+
+(defn loginbar [user]
+  [:ul.nav.navbar-nav.navbar-right
+   (if user
+     (list
+      [:li [:a "Logged in as " [:b (:username user)]]]
+      [:li [:a {:href "/logout"} "Logout"]])
+     [:li [:a {:href "/login"} "Login"]])])

 (defn navbar [user]
   [:div.navbar.navbar-default {:role "navigation"}
@@ -16,11 +24,7 @@
     [:div.collapse.navbar-collapse
      {:id "navbar-collapse-target"}
      [:ul.nav.navbar-nav.navbar-right
-      (if user
-        (list
-         [:li [:a "Logged in as " [:b (:username user)]]]
-         [:li [:a {:href "/logout"} "Logout"]])
-        [:li [:a {:href "/login"} "Login"]])]]]])
+      (loginbar user)]]]])

 (defn common [user & body]
   (html5


Stroke color lighter.

Stroke color lighter.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -195,10 +195,10 @@
                          (if (= :put wait-kind)
                            ["<line x1='500' y1='" (actx-y actx)
                             "' x2='600' y2='" (ch-y ch)
-                            "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/>"]
+                            "' stroke='#afa' stroke-width='1' marker-end='url(#triangle)'/>"]
                            ["<line x1='600' y1='" (ch-y ch)
                             "' x2='500' y2='" (actx-y actx)
-                            "' stroke='red' stroke-width='1' marker-end='url(#triangle)'/>"])))
+                            "' stroke='#faa' stroke-width='1' marker-end='url(#triangle)'/>"])))
                      (:wait-chs actx-info))))
            (:actxs vis))
      (mapv (fn [delta]


Don't keep all results.

Don't keep all results.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -195,16 +195,16 @@
     (ago w-actx w
          (reset! root-actx w-actx)
          (let [in (achan-buf w-actx 100)
-               out (achan-buf w-actx 1)]
-           (ago-loop main-in w-actx [num-cmds 0]
+               out (achan-buf w-actx 0)]
+           (ago-loop main-in w-actx [num-ins 0]
                      (let [cmd (<! cmds)
                            cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
                        (aput main-in in cmd-handler)
-                       (recur (inc num-cmds))))
-           (ago-loop main-out w-actx [acc nil]
+                       (recur (inc num-ins))))
+           (ago-loop main-out w-actx [num-outs 0]
                      (let [result (atake main-out out)]
                        (set-el-innerHTML "output" result)
-                       (recur (conj acc result))))
+                       (recur (inc num-outs))))
            (make-fenced-pump w-actx in out @max-inflight)))))

 ;; ------------------------------------------------


Tweak commentary.

Tweak commentary.

--- src/cbfg/fence.clj
+++ src/cbfg/fence.clj
@@ -42,13 +42,13 @@
                                       nil)))
          (= v nil) (let [new-inflights (disj inflights ch)] ; an inflight request is done.
                      (if (empty? new-inflights)
-                       (do (when fenced-res               ; all inflight requests are done, so we can now
-                             (>! out-channel fenced-res)) ; send the fenced-res that we've been holding up.
+                       (do (when fenced-res                 ; all inflight requests are done, so we can
+                             (>! out-channel fenced-res))   ; send the fenced-res that we've been keeping.
                            (recur new-inflights nil nil))
                        (recur new-inflights fenced fenced-res)))
          (= ch fenced) (do (when fenced-res
-                             (>! out-channel fenced-res)) ; send off any previous fenced-res
-                           (recur inflights fenced v))     ; so that we can save v as fenced-res.
+                             (>! out-channel fenced-res))   ; send off any previous fenced-res so
+                           (recur inflights fenced v))      ; we can keep v as fenced-res.
          :else (do (>! out-channel v)
                    (recur inflights fenced fenced-res)))))
     {:in in-channel


Update `make-app` function, so it works with realistic data.

--- src/containium/http_kit.clj
+++ src/containium/http_kit.clj
@@ -53,20 +53,22 @@
   registered RingApps."
   []
   (let [handler (if-let [apps (seq (vals @apps))]
-                  (let [sorted (sort-apps apps)
-                        fn-form `(fn [~'request]
+                  (let [sorted (vec (sort-apps apps))
+                        fn-form `(fn [~'sorted ~'request]
                                    (let [~'uri (:uri ~'request)
                                          ~'server-name (:server-name ~'request)]
-                                     (or ~@(for [app sorted]
+                                     (or ~@(for [index (range (count sorted))
+                                                 :let [app (get sorted index)]]
                                              `(when (matcher ~(:ring-conf app) ~'uri ~'server-name)
-                                                (boxure/call-in-box
-                                                 ~(:box app)
-                                                 ~(:handler-fn app)
-                                                 ~(if-let [cp (-> app :ring-conf :context-path)]
-                                                    `(update-in ~'request [:uri]
-                                                                #(subs % ~(count cp)))
-                                                    ~'request)))))))]
-                    (eval fn-form))
+                                                (let [~'app (get ~'sorted ~index)]
+                                                  (boxure/call-in-box
+                                                   (:box ~'app)
+                                                   (:handler-fn ~'app)
+                                                   ~(if-let [cp (-> app :ring-conf :context-path)]
+                                                      `(update-in ~'request [:uri]
+                                                                  #(subs % ~(count cp)))
+                                                      'request))))))))]
+                    (partial (eval fn-form) sorted))
                   (constantly {:status 503 :body "no apps loaded"}))]
     (alter-var-root #'app (constantly handler))))

@@ -94,17 +96,22 @@
   The second is a regular expression, which is matched against the
   server name of the request, for example \".*containium.com\"."
   [{:keys [name project] :as box}]
+  (println "Adding ring handler in module" name "...")
   (let [ring-conf (clean-ring-conf (-> project :containium :ring))
-        handler-fn (boxure/eval box (:handler-sym ring-conf))]
+        handler-fn @(boxure/eval box (:handler-sym ring-conf))]
     (swap! apps assoc name (RingApp. box handler-fn ring-conf))
-    (make-app)))
+    (make-app)
+    (println "Ring handler for module" name "added, in context:"
+             (or (:context-path ring-conf) "/"))))

 (defn remove-box
   "Removes a box's ring handler from the ring server."
   [{name :name}]
+  (println "Removing ring handler of" name "module...")
   (swap! apps dissoc name)
-  (make-app))
+  (make-app)
+  (println "Ring handler of module" name "removed."))

 ;;; Ring server management.


move stefon-manifest.json to resources/public/assets

--- src/frontend/tasks/http.clj
+++ src/frontend/tasks/http.clj
@@ -12,7 +12,7 @@
 (def stefon-options {:asset-roots frontend.stefon/asset-roots
                      :precompiles frontend.stefon/precompiles
                      :serving-root "resources/public"
-                     :manifest-file "resources/assets/stefon-manifest.json"
+                     :manifest-file "resources/public/assets/stefon-manifest.json"
                      :mode :production})

 (defn update-hosted-scripts [scripts]


cleanup

cleanup

--- src/mekena/logistic-reg.clj
+++ src/mekena/logistic-reg.clj
@@ -1,5 +1,24 @@
 (ns mekena.logistic-reg
-   (:require [incanter.core :as i]))
+  (:require [incanter.core :as i]
+            [incanter.io :as io]
+            [incanter.charts :as charts]))
+
+;; read housing data
+(def training-data (io/read-dataset "./resources/ex2data1.txt"))
+;; select the x and y columns of the matrix
+(def exam1 (i/sel training-data :cols 0))
+(def exam2 (i/sel training-data :cols 1))
+(def admitted (i/sel training-data :cols 2))
+
+;; plot the training data for the exams, use group-by to separate
+;; admitted vs. not admitted
+(i/view (charts/scatter-plot
+          :col0
+          :col1
+          :group-by :col2
+          :data training-data
+          :x-label "Exam 1 score"
+          :y-label "Exam 2 score"))

 (defn sigmoid
   "sigmoid function: 1/(1+e^-z)
@@ -7,3 +26,57 @@
   [z]
   (i/div 1 (i/plus 1 (i/exp (i/minus z)))))

+(defn hypothesis
+  "sigmoid function: 1/(1+e^-z)"
+  [z]
+  (/ 1 (inc (Math/exp (- z)))))
+
+(defn prepare-features
+  "append a column of 1s as feature 0"
+  [xs]
+  (-> xs
+      i/nrow
+      (repeat 1)
+      (i/bind-columns xs)))
+
+(defn normalize
+  "normalize a feature by subtracting the mean and scale by the std dev"
+  [mtrx]
+  (let [mean (stats/mean mtrx)
+        sd (stats/sd mtrx)]
+    (vec (map (comp (fn [n] (/ n sd)) (fn [n] (- n mean))) mtrx))))
+
+(defn normalize-features
+  "Normalize all features of input dataset"
+  [xs]
+  (->> (i/ncol xs)
+       range
+       (map (fn [c] (normalize (i/sel xs :cols c))))
+       matrix
+       trans
+       prepare-features))
+
+(defn compute-cost
+  "Calculate the cost of using theta (mse : mean square error):
+   -1/m Sigma (1,m)[ y.log( h(theta.x) ) + (1 - y).log( 1 - h(theta.x) )]
+   input xs is dataset "
+  [xs y theta]
+  (let [normalized-x (normalize-features xs)
+        theta-x      (i/mmult normalized-x theta)
+        h-tx         (i/matrix-map hypothesis theta-x)
+        y-1-term     (i/mmult (i/trans y) (i/log h-tx))
+        y-0-term     (i/mmult (i/trans (i/minus 1 y)) (i/log (i/minus 1 h-tx)))
+        m            (count y)]
+    (-> y-1-term
+        (i/plus y-0-term)
+        (i/div (- m)))))
+
+;; deftest : compute-cost xs y [0 0 0] => 0.693
+;; where: xs : (sel training-data :except-cols (dec (ncol training-data)))
+;; y : (def y (sel training-data :cols (dec (ncol training-data))))
+
+(defn gradient
+  "Compute the partial derivatives and set gradient to the partial
+  derivatives of the cost w.r.t. each parameter in theta
+  gradient should have the same dimensions as theta"
+  [theta x y])


hide private functions

hide private functions

--- src/metabase/util/stats.clj
+++ src/metabase/util/stats.clj
@@ -2,6 +2,7 @@
   "Functions which summarize the usage of an instance"
   (:require [clojure.tools.logging :as log]
             [clj-http.client :as client]
+            [environ.core :as environ]
             (metabase [config :as config]
                       [db :as db])
             [metabase.public-settings :as settings]
@@ -63,7 +64,7 @@
   )

-(defn bin-large-number
+(defn- bin-large-number
   "Return large bin number. Assumes positive inputs"
   [x]
   (cond
@@ -77,13 +78,13 @@
     (> x 10000) "10000+")
   )

-(defn get-value-frequencies
+(defn- get-value-frequencies
   "go through a bunch of maps and count the frequency a given key's values"
   [many-maps k]
   (frequencies (map k many-maps))
   )

-(defn histogram
+(defn- histogram
   "Bin some frequencies using a passed in binning function"
   [binning-fn many-maps k]
   (frequencies (map binning-fn (vals (get-value-frequencies many-maps k))))
@@ -105,12 +106,17 @@
   "return a histogram for large numbers"
   (partial histogram bin-large-number))

-(defn instance-start-date?
+(defn- instance-start-date?
   "Pull up the first user account and use that date"
   []
   ((first (db/select 'User {:limit 1} {:order-by [[:date_joined :desc]]})) :date_joined)
   )

+(defn- where-am-i-running?
+  "Figure out what we're running under"
+  []
+
+  )
 (defn- get-settings
   "Figure out global info aboutt his instance"
   []
@@ -136,7 +142,7 @@
   )

 ;; User metrics
-(defn user-dims
+(defn- user-dims
   "characterize a user record"
   [user]
   {:total 1
@@ -147,7 +153,7 @@
   )

-(defn get-user-metrics
+(defn- get-user-metrics
   "Get metrics based on user records
   TODO: get activity in terms of created questions, pulses and dashboards"
   []
@@ -155,7 +161,7 @@
     {:users (apply add-summaries (map user-dims users))}))

-(defn get-group-metrics
+(defn- get-group-metrics
   "Get metrics based on groups:
   TODO characterize by # w/ sql access, # of users, no self-serve data access"
   []
@@ -163,7 +169,7 @@
     {:groups (count groups)}))

 ;; Artifact Metrics
-(defn question-dims
+(defn- question-dims
   "characterize a saved question
   TODO: characterize by whether it has params, # of revisions, created by an admin"
   [question]
@@ -172,14 +178,14 @@
      :gui (if (not= (question :iquery_type) "native") 1 0)}
   )

-(defn get-question-metrics
+(defn- get-question-metrics
   "Get metrics based on questions
   TODO characterize by # executions and avg latency"
   []
   (let [questions (db/select 'Card)]
     {:questions (apply add-summaries (map question-dims questions))}))

-(defn get-dashboard-metrics
+(defn- get-dashboard-metrics
   "Get metrics based on dashboards
   TODO characterize by # of revisions, and created by an admin"
   []
@@ -190,7 +196,7 @@
      :num_cards_per_dash (medium-histogram dashcards :dashboard_id)
      :num_dashs_per_card (medium-histogram dashcards :card_id)}))

-(defn get-pulse-metrics
+(defn- get-pulse-metrics
   "Get metrics based on pulses
   TODO: characterize by non-user account emails, # emails"
   []
@@ -205,7 +211,7 @@
      :num_cards_per_pulses (medium-histogram pulsecards :pulse_id)}))

-(defn get-label-metrics
+(defn- get-label-metrics
   "Get metrics based on labels"
   []
   (let [labels (db/select 'CardLabel)]
@@ -214,21 +220,21 @@
      :num_cards_per_label (medium-histogram labels :label_id)}))

 ;; Metadata Metrics
-(defn database-dims
+(defn- database-dims
   "characterize a database record"
   [database]
   {:total 1
    :analysed (if (database :is_full_sync) 1 0)}
   )

-(defn get-database-metrics
+(defn- get-database-metrics
   "Get metrics based on databases"
   []
   (let [databases (db/select 'Database)]
     {:databases (apply add-summaries (map database-dims databases))}))

-(defn get-table-metrics
+(defn- get-table-metrics
   "Get metrics based on tables"
   []
   (let [tables (db/select 'Table)]
@@ -238,7 +244,7 @@
      }))

-(defn get-field-metrics
+(defn- get-field-metrics
   "Get metrics based on fields"
   []
   (let [fields (db/select 'Field)]
@@ -247,27 +253,27 @@

-(defn get-segment-metrics
+(defn- get-segment-metrics
   "Get metrics based on segments"
   []
   (let [segments (db/select 'Segment)]
     {:segments (count segments)}))

-(defn get-metric-metrics
+(defn- get-metric-metrics
   "Get metrics based on metrics"
   []
   (let [metrics (db/select 'Metric)]
     {:metrics (count metrics)}))

-(defn bin-latencies
+(defn- bin-latencies
   "Bin latencies, which are in milliseconds"
   [query-executions]
   (let [latency-vals (map #(/ %1 1000) (map :running_time query-executions))]
     (frequencies (map bin-large-number latency-vals))))

 ;; Execution Metrics
-(defn get-execution-metrics
+(defn- get-execution-metrics
   "Get metrics based on executions.
   This should be done in a single pass, as there might
   be a LOT of query executions in a normal instance
@@ -280,7 +286,7 @@
      :num_per_card (large-histogram executions :table_id)
      :num_by_latency (bin-latencies executions)}))

-(defn get-map-metrics
+(defn- get-map-metrics
   "Get metrics based on custom geojson maps
   TODO figure out how to get at these"
   []


Fix bug

Fix bug

--- src/obb_rules/game_mode.clj
+++ src/obb_rules/game_mode.clj
@@ -6,7 +6,7 @@
   "Checks if the game is finished"
   [game]
   (and
-    (not (= game/state :deploy))
+    (not (= (game/state game) :deploy))
     (or
       (board/empty-board? game :p1)
       (board/empty-board? game :p2))))


test/run.clj: modified -main to load org.altlaw.load-all

For running at command line.
Don't want to require in (ns...) because that
makes a circular dependency with load-all.

--- src/org/altlaw/test/run.clj
+++ src/org/altlaw/test/run.clj
@@ -3,5 +3,6 @@
   (:gen-class))

 (defn -main [& args]
+  (require 'org.altlaw.load-all)
   (t/run-all-tests))


Add pepa.model/changed-entities.

Add pepa.model/changed-entities.

Function which returns a map of changed entity-ids since a given point
in time described by a seqs-map.

--- src/pepa/model.clj
+++ src/pepa/model.clj
@@ -109,8 +109,8 @@
 (defn document-pages
   "Returns a list of pages for the document with ID."
   [db id]
-  (db/query db ["SELECT p.file, p.number, p.rotation
-                 FROM pages AS p
+  (db/query db ["SELECT p.file, p.number, p.rotation
+                 FROM pages AS p
                  JOIN document_pages AS dp on dp.page = p.id
                  WHERE dp.document = ?
                  ORDER BY dp.number" id]))
@@ -170,7 +170,7 @@
   (assert (every? string? added-tags))
   (assert (every? string? removed-tags))
   (assert (every? #{:title} (keys props)))
-
+
   (db/with-transaction [conn db]
     (if-let [document (get-document conn id)]
       (let [added-tags (set added-tags)
@@ -333,11 +333,79 @@
 (def ^:private sequenced-tables
   [:pages :page_images :files :documents :document_tags :document_pages])

+(defn ^:private valid-seqs? [seq]
+  (and (every? (set sequenced-tables) (keys seq))
+       (every? integer? (vals seq))
+       (= (set sequenced-tables) (set (keys seq)))))
+
 (let [names (map name sequenced-tables)
       where (s/join ", " (map #(str % "_state_seq as " %) names))
       select (s/join ", " (map #(str % ".current as " %) names))
       query (str "SELECT " select " FROM " where)]
   (defn sequence-numbers [db]
     (-> db
-        (db/query [query] :identifiers (comp keyword #(s/replace % "_" "-")))
+        (db/query [query])
         (first))))
+
+(defmulti ^:private changed-entities* (fn [db table seq-num] table))
+
+(defmethod changed-entities* :default [_ _ _] nil)
+
+(defmethod changed-entities* :documents [db _ seq-num]
+  {:documents (mapv :id (db/query db ["SELECT id FROM documents WHERE state_seq > ?" seq-num]))})
+
+(defmethod changed-entities* :document_pages [db _ seq-num]
+  {:documents (->> (db/query db ["SELECT DISTINCT d.id
+                                  FROM document_pages AS dp
+                                  LEFT JOIN documents as d
+                                    ON d.id = dp.document
+                                  WHERE dp.state_seq > ?" seq-num])
+                   (mapv :id))})
+
+(defmethod changed-entities* :document_tags [db _ seq-num]
+  {:documents (->> (db/query db ["SELECT DISTINCT d.id
+                                  FROM document_tags AS dt
+                                  LEFT JOIN documents as d
+                                    ON d.id = dt.document
+                                  WHERE dt.state_seq > ?" seq-num])
+                   (mapv :id))})
+
+(defmethod changed-entities* :pages [db _ seq-num]
+  (let [pages (mapv :id (db/query db ["SELECT id FROM pages WHERE state_seq > ?" seq-num]))]
+    {:pages pages
+     :documents (when (seq pages)
+                  (->>
+                   (db/query db (db/sql+placeholders
+                                 "SELECT DISTINCT dp.document
+                                  FROM document_pages AS dp
+                                  WHERE dp.page IN (%s)" pages))
+                   (mapv :document)))}))
+
+(defmethod changed-entities* :page_images [db _ seq-num]
+  (let [pages (->>
+               (db/query db ["SELECT DISTINCT p.id
+                              FROM page_images as pi
+                              LEFT JOIN pages as p ON p.id = pi.page
+                              WHERE pi.state_seq > ?" seq-num])
+               (map :id))]
+    {:pages pages
+     :documents (when (seq pages)
+                  (->>
+                   (db/query db (db/sql+placeholders
+                                 "SELECT DISTINCT dp.document
+                                  FROM document_pages AS dp
+                                  WHERE dp.page IN (%s)" pages))
+                   (mapv :document)))}))
+
+(defmethod changed-entities* :files [db _ seq-num]
+  {:files (mapv :id (db/query db ["SELECT id FROM files WHERE state_seq > ?" seq-num]))})
+
+(defn changed-entities
+  "Takes a seqs-map and returns a map containing IDs for all changed
+  entities since that point in time."
+  [db seqs]
+  (if (valid-seqs? seqs)
+    (db/with-transaction [db db]
+      (apply (partial merge-with #(into (set %1) %2))
+             (map #(apply changed-entities* db %) seqs)))
+    (throw (ex-info "Didn't get a valid (and complete) seqs-map!" {:seqs seqs}))))


parse json datestrings

parse json datestrings

--- src/otto/github.clj
+++ src/otto/github.clj
@@ -17,7 +17,7 @@
   (fn [url response-fn]
     (http/get url {:basic-auth [(:name user) (:token user)]} response-fn)))

-(defn- next-url
+(defn- parse-next-url
   [headers]
   (->> (:link headers)
        str
@@ -25,17 +25,27 @@
        vec
        last))

+(defn- parse-json-date
+  [date]
+  (if-not (clojure.string/blank? date)
+    (.parse (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss'Z'") date)))
+
+(defn- parse-json-val
+  [k v]
+  (if (= k :pushed_at) (parse-json-date v) v))
+
 (defn- make-response-fn
   [success-fn]
   (fn [{:keys [body error headers status]}]
     (if (and (nil? error) (= 200 status))
-      (let [next-url (next-url headers)]
+      (let [next-url (parse-next-url headers)]
         (success-fn body next-url))))) ;; TODO error

 (defn- make-json-response-fn
   [success-fn]
   (make-response-fn (fn [body next-url]
-                      (let [json (json/read-str body :key-fn keyword)]
+                      (let [json (json/read-str body :key-fn   keyword
+                                                     :value-fn parse-json-val)]
                         (success-fn json next-url)))))

 (defn- make-json-collection-fn


Add permission

Add permission

--- src/nightmod/sandbox.clj
+++ src/nightmod/sandbox.clj
@@ -3,7 +3,9 @@
             [clojail.jvm :as jvm]
             [clojail.testers :as jail-test]
             [clojure.java.io :as io]
-            [nightmod.utils :as u]))
+            [nightmod.utils :as u])
+  (:import [java.io FilePermission]
+           [java.lang.reflect ReflectPermission]))

 (def tester
   [(jail-test/blacklist-objects
@@ -30,7 +32,8 @@
    (jail-test/blanket "clojail")])

 (def context (-> (doto (jvm/permissions)
-                   (.add (java.io.FilePermission. "<<ALL FILES>>" "read")))
+                   (.add (FilePermission. "<<ALL FILES>>" "read"))
+                   (.add (ReflectPermission. "suppressAccessChecks")))
                  jvm/domain
                  jvm/context))


Add digest subtitle

Add digest subtitle

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -249,9 +249,9 @@
    horizontal-line
    (spacer 32)
    (h2 (:headline entry))
-   (spacer 16)
+   (spacer 24)
    (post-attribution entry)
-   (spacer 16)
+   (spacer 24)
    (read-post-button "Read post" (:url entry))])

 (defn- posts-with-board-name [board]
@@ -270,7 +270,8 @@
         title (if weekly? "Your weekly brief" "Your morning brief")
         boards (map posts-with-board-name (:boards digest))
         posts (mapcat :posts boards)
-        digests-url (s/join "/" [config/web-url (:org-slug digest) "all-posts"])]
+        digests-url (s/join "/" [config/web-url (:org-slug digest) "all-posts"])
+        subtitle (str "Good morning! Here are the new posts shared to the " (:org-name digest) " digest this " (if weekly? "past week" "yesterday") ".")]
     [:td {:class "small-10 large-8 columns"}
       (spacer 40)
       (when logo? (org-logo {:org-name (:org-name digest)
@@ -279,6 +280,8 @@
                              :org-logo-height (:logo-height digest)}))
       (when logo? (spacer 40))
       (h1 title)
+      (spacer 20)
+      (paragraph subtitle)
       (spacer 20)
       (left-button "Go to digest" digests-url)
       (mapcat post posts)


If the user has one of our default happy face avatars replace the svg extension with the png.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -142,6 +142,15 @@
          "circle/"
          filestack-resource)))

+(defn- fix-avatar-url
+  "If the url is pointing to one of our happy faces replace the ending svg with png to have it resizable.
+   If it's not use the on the fly resize url."
+  [avatar-url]
+  (let [r (re-seq #"happy_face_(red|green|blue|purple|yellow).svg$" avatar-url)]
+    (if r
+      (str (subs avatar-url 0 (- (count avatar-url) 3)) "png")
+      (circle-image avatar-url 32))))
+
 (defn- note-author [avatar-url author divider-line?]
   [:table {:class "row"}
     [:tr
@@ -150,7 +159,8 @@
           horizontal-line)
         (when divider-line?
           (spacer 16))
-        [:img {:class "note-author-avatar" :src (circle-image avatar-url 32)}]
+        [:img {:class "note-author-avatar"
+               :src (fix-avatar-url avatar-url)}]
         [:span {:class "note-author-name"} author]]]])

 (defn- read-post-button [link-text link-url]
@@ -242,8 +252,6 @@

 ;; ----- Digest -----

-
-
 (defn- post [entry]
   [(spacer 32)
    horizontal-line


Fix clone-element to actually merge instead of overwrite new quescent props

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -141,4 +141,5 @@
      (doto (if (nil? react-props)
              #js{}
              (gobj/clone react-props))
-       (aset "value" quiescent-props)))))
+       (aset "value" (into (element-props quiescent-react-element)
+                       quiescent-props))))))


Delete unused file

Delete unused file

Seems I accidentally committed a file used for testing during development.

--- src/refactor_nrepl/test.clj
+++ src/refactor_nrepl/test.clj
@@ -1,11 +0,0 @@
-;; (ns refactor-nrepl.test
-;;   (:require [compojure
-;;              [core :refer [defroutes]]
-;;              [route :as route]]
-;;             [website.github-manager :as gman])
-;;   (:gen-class))
-
-;; (defroutes routes
-;;   gman/routes
-;;   fp/routes
-;;   (route/resources "/"))


Add line breaks

Add line breaks

--- src/datemo/arb.clj
+++ src/datemo/arb.clj
@@ -68,7 +68,9 @@
           (into [(:original-tag metadata) {}] hiccups)
           (if (string? (first items))
             (recur (conj hiccups (first items)) (next items))
-            (recur (conj hiccups (arb->hiccup (first items))) (next items))))))))
+            (recur
+              (conj hiccups (arb->hiccup (first items)))
+              (next items))))))))

 (defn tx->html [tx]
   (-> tx (tx->arb) (arb->hiccup) (html)))


Add `of-days`

Add `of-days`

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -607,6 +607,15 @@
   "Takes a java.lang.Long n and returns a duration of n hours."
   [n]
   (new-duration n :hours))
+
+
+;; Periods. Convenience functions to create durations of specific
+;; units.
+
+(defn of-days
+  "Takes a java.lang.Long n and returns a period of n days."
+  [n]
+  (new-period n :days))

 ;; Coercions


Use proper namespace names

Use proper namespace names

--- src/trak/core.cljs
+++ src/trak/core.cljs
@@ -8,7 +8,11 @@
     [rum.core :as rum]
     [trak.api :as api]
     [trak.ui.app :as ui.app]
-    [trak.action-handlers :as action-handlers]))
+    [trak.action_handlers :as action-handlers]
+    [trak.pubsub :as pubsub]
+    ;[trak.config :as conf :refer [cljs-env]]
+    )
+  )

 (enable-console-print!)

@@ -39,7 +43,7 @@
                             @*db name))]
     (if (nil? channel)
       nil
-      (trak.pubsub/unsubscribe (:subscription/topic channel) (:subscription/channel channel)))
+      (pubsub/unsubscribe (:subscription/topic channel) (:subscription/channel channel)))
     (let [new-channel (pubsub/subscribe
                         topic
                         callback)]


hack to make lines work

hack to make lines work

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -3,6 +3,7 @@
             [cljs.core.async :refer [put!]]
             [frontend.camera :as cameras]
             [frontend.datascript :as ds]
+            [frontend.layers :as layers]
             [frontend.models.layer :as layer-model]
             [frontend.settings :as settings]
             [frontend.state :as state]
@@ -102,12 +103,12 @@
                                                    (js/console.log event)
                                                    ((:handle-mouse-up handlers) event))
                                      :onTouchMove (fn [event]
-                                                     (let [touches (.-touches event)]
-                                                       (when (= (.-length touches) 1)
-                                                         (.preventDefault event)
-                                                         (.stopPropagation event)
-                                                         (js/console.log event)
-                                                         ((:handle-mouse-move! handlers) (aget touches "0")))))
+                                                    (let [touches (.-touches event)]
+                                                      (when (= (.-length touches) 1)
+                                                        (.preventDefault event)
+                                                        (.stopPropagation event)
+                                                        (js/console.log event)
+                                                        ((:handle-mouse-move! handlers) (aget touches "0")))))
                                      :onMouseDown (fn [event]
                                                     (.preventDefault event)
                                                     (.stopPropagation event)
@@ -177,28 +178,34 @@
                                                                          (get-in sel [:layer/end-sy]))})
                                         el-type (cond
                                                  (= (get-in payload state/current-tool-path) :line) dom/line
-                                                 :else dom/dom)]
+                                                 :else dom/dom)
+                                        x-direction (if (neg? (- (:layer/start-x sel) (:layer/current-x sel))) -1 1)
+                                        y-direction (if (neg? (- (:layer/start-y sel) (:layer/current-y sel))) -1 1)
+                                        rect (svg/layer->svg-rect (:camera payload) sel false cast!)]
                                     (if (= :line (get-in payload state/current-tool-path))
-                                      (let [l (cameras/camera-translated-rect (:camera payload) sel (- (:layer/current-x sel) (:layer/start-x sel))
-                                                                              (- (:layer/current-y sel) (:layer/start-y sel)))]
-                                        (dom/line (clj->js (merge
-                                                            (dissoc l :x :y :width :height :stroke-width :fill)
-                                                            {:x1          (:layer/start-x l)
-                                                             :y1          (:layer/start-y l)
-                                                             :x2          (:layer/current-x l)
-                                                             :y2          (:layer/current-y l)
+                                      (dom/line (clj->js (merge
+                                                          (dissoc rect :x :y :width :height :stroke-width :fill)
+                                                          ;; TODO: figure out how this actually works, right now it's just
+                                                          ;;       the result of changing signs until it worked!
+                                                          (let [x1 (if (neg? x-direction)
+                                                                     (+ (:x rect) (:width rect))
+                                                                     (:x rect))
+                                                                y1 (if (neg? y-direction)
+                                                                     (+ (:y rect) (:height rect))
+                                                                     (:y rect))]
+                                                            {:x1 x1
+                                                             :y1 y1
+                                                             :x2 (+ (* x-direction (:width rect)) x1)
+                                                             :y2 (+ (* y-direction (:height rect)) y1)
                                                              :fill "gray"
                                                              :fillOpacity "0.25"
                                                              :strokeDasharray "5,5"
                                                              :strokeWidth 1}))))
-                                      (dom/rect
-                                       (clj->js (assoc (svg/layer->svg-rect (:camera payload) sel
-                                                                            false
-                                                                            cast!)
-                                                  :fill "gray"
-                                                  :fillOpacity "0.25"
-                                                  :strokeDasharray "5,5"
-                                                  :strokeWidth 1))))))
+                                      (dom/rect (clj->js (assoc rect
+                                                           :fill "gray"
+                                                           :fillOpacity "0.25"
+                                                           :strokeDasharray "5,5"
+                                                           :strokeWidth 1))))))
                                 #_(dom/text #js {:x 15
                                                  :y 15} (pr-str (dissoc payload :layers)))]
                                [(when (cameras/guidelines-enabled? payload)


Update header dropdown & primary links

Update header dropdown & primary links

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -128,12 +128,33 @@
               (common/circle-logo {:width nil
                                    :height 25})]]
             [:ul.nav.navbar-nav
-             [:li [:a {:href "/about"} "About"]]
+             [:li.dropdown
+              [:a {:href "/features"} "Product"]
+              [:ul.dropdown-menu
+               [:li {:role "presentation"}
+                [:a {:role "menuitem"
+                     :tabindex "-1"
+                     :href "/features"}
+                 "Features"]]
+               [:li {:role "presentation"}
+                [:a {:role "menuitem"
+                     :tabindex "-1"
+                     :href "/mobile"}
+                 "Mobile"]]
+               [:li {:role "presentation"}
+                [:a {:role "menuitem"
+                     :tabindex "-1"
+                     :href "/integrations/docker"}
+                 "Docker"]]
+               [:li {:role "presentation"}
+                [:a {:role "menuitem"
+                     :tabindex "-1"
+                     :href "/enterprise"}
+                 "Enterprise"]]]]
              (when-not (config/enterprise?)
                [:li [:a {:href "/pricing"} "Pricing"]])
              [:li [:a {:href "/docs"} "Documentation"]]
-             (when-not (config/enterprise?)
-               [:li [:a {:href "/jobs"} "Jobs"]])
+             [:li [:a {:href "/about"} "About Us"]]
              [:li [:a {:href "http://blog.circleci.com"} "Blog"]]]

             (if logged-in?


better organization to prevent unnecessary re-renders

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -390,6 +390,38 @@
             (:issue/title issue)]
            (issue-tags issue)]])))))

+(defn issue-list [_ owner]
+  (reify
+    om/IDisplayName (display-name [_] "Issue List")
+    om/IInitState
+    (init-state [_] {:listener-key (.getNextUniqueId (.getInstance IdGenerator))})
+    om/IDidMount
+    (did-mount [_]
+      (fdb/add-attribute-listener (om/get-shared owner :issue-db)
+                                  :issue/title
+                                  (om/get-state owner :listener-key)
+                                  (fn [tx-report]
+                                    (om/refresh! owner))))
+    om/IWillUnmount
+    (will-unmount [_]
+      (fdb/remove-attribute-listener (om/get-shared owner :issue-db)
+                                     :issue/title
+                                     (om/get-state owner :listener-key)))
+    om/IRender
+    (render [_]
+      (let [{:keys [cast! issue-db cust]} (om/get-shared owner)]
+        (html
+         [:div.menu-view
+          [:div.content
+           [:div.make {:key "issue-form"}
+            (om/build issue-form {})]
+           [:div.make {:key "summary"}
+            (when-let [issues (seq (map #(d/entity @issue-db (:e %)) (d/datoms @issue-db :aevt :issue/title)))]
+              (om/build-all issue-summary (map (fn [i] {:issue-id (:db/id i)})
+                                               (sort (issue-model/issue-comparator cust (datetime/server-date)) issues))
+                            {:key :issue-id
+                             :opts {:issue-db issue-db}}))]]])))))
+
 (defn issues* [app owner {:keys [submenu]}]
   (reify
     om/IDisplayName (display-name [_] "Issues")
@@ -402,37 +434,20 @@
        (om/get-state owner :listener-key)
        (om/get-shared owner :comms)
        (om/get-shared owner :sente))
-      (fdb/add-attribute-listener (om/get-shared owner :issue-db)
-                                  :issue/title
-                                  (om/get-state owner :listener-key)
-                                  (fn [tx-report]
-                                    (om/refresh! owner)))
-      (sente/subscribe-to-issues (:sente app)
+      (sente/subscribe-to-issues (om/get-shared owner :sente)
                                  (om/get-shared owner :comms)
                                  (om/get-shared owner :issue-db)))
     om/IWillUnmount
     (will-unmount [_]
-      (d/unlisten! (om/get-shared owner :issue-db) (om/get-state owner :listener-key))
-      (fdb/remove-attribute-listener (om/get-shared owner :issue-db)
-                                     :issue/title
-                                     (om/get-state owner :listener-key)))
-    om/IRender
-    (render [_]
-      (let [{:keys [cast! issue-db cust]} (om/get-shared owner)]
-        (html
-         [:div.menu-view
-          [:div.content
-           (when-not submenu
-             [:div.make {:key "issue-form"}
-              (om/build issue-form {})])
-           [:div.make {:key (or submenu "summary")}
-            (if submenu
-              (om/build issue {:issue-id (:active-issue-id app)} {:key :issue-id})
-              (when-let [issues (seq (map #(d/entity @issue-db (:e %)) (d/datoms @issue-db :aevt :issue/title)))]
-                (om/build-all issue-summary (map (fn [i] {:issue-id (:db/id i)})
-                                                 (sort (issue-model/issue-comparator cust (datetime/server-date)) issues))
-                              {:key :issue-id
-                               :opts {:issue-db issue-db}})))]]])))))
+      (d/unlisten! (om/get-shared owner :issue-db) (om/get-state owner :listener-key)))
+    om/IRender
+    (render [_]
+      (html
+       [:div.menu-view
+        [:div.content
+         (if submenu
+           (om/build issue {:issue-id (:active-issue-id app)} {:key :issue-id})
+           (om/build issue-list {} {:react-key "issue-list"}))]]))))

 (defn issues [app owner {:keys [submenu]}]
   (reify


Rework experiment preparation.

Rework experiment preparation.


omino-count checking logic is added.

omino-count checking logic is added.

--- src-cljx/polyomino_enclosure/engine.cljx
+++ src-cljx/polyomino_enclosure/engine.cljx
@@ -118,7 +118,8 @@
               "原点を含まないポリオミノがあります。"))
           (validate-form []
             (let [[omino-count & omino-counts] (map count polyominos)]
-              (if-not (and (every? #(= % omino-count) omino-counts)
+              (if-not (and (<= 1 (first omino-counts) 12)
+                           (every? #(= % omino-count) omino-counts)
                            (every? #(= (area-size (board %)) omino-count) polyominos))
                 "不正なポリオミノがあります。")))
           (validate-duplication []


Sorting diffs by natural ordering of key paths.

--- src/flare/core.clj
+++ src/flare/core.clj
@@ -70,6 +70,7 @@
   [diffs]
   (->> diffs
        flatten-keys
+       sort
        (map generate-report-for-keyed-diff)))


Replace code to tuples-to-hash call.

Replace code to tuples-to-hash call.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -71,18 +71,18 @@
 (defn get-story-ctx []
   {"my" (story-utils/instantiate-type (get types "_player"))})

-;; keys+vals -> vals
 (defn name-into-objs [objs]
-  (map (fn [x] (assoc (val x) :name (key x)))
-       objs))
+  (tuples-to-hash (map (fn [{k 0 v 1}]
+                         [k (if (and (contains? v :name) (str/blank? (:name v)))
+                              (assoc v :name k)
+                              v)])
+                       objs)))

 (defn extract-by-class [ctx clazz]
-  (filter
-   (fn [x] (= clazz (class (val x))))
-   ctx))
+  (tuples-to-hash (filter
+                   (fn [x] (= clazz (class (val x))))
+                   ctx)))

-(defn seq-to-hash [seq- key-]
-  (reduce (fn [hash el] (assoc hash (key- el) el)) {} seq-))
 (defn tuples-to-hash [seq-]
   (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
           {}


Move room and look fn.

Move room and look fn.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -24,6 +24,8 @@
   (item [this name]))

 (defprotocol Playable
+  (look [this arguments-str]))
+
 (def room-defaults ["" "" [] :undefined])
 (defrecord Room [name summary items exit]
   QueryableRoom
@@ -43,17 +45,13 @@
         nil)))

   Playable
-  (look [this arguments]
-    (if (nil? arguments)
-      (:summary (get player :room))
-      (let [arguments-vec (str/split arguments #" ")]
-        (if (= "at" (first arguments-vec))
-          (if-let [item (get-item this (second arguments-vec))]
-            (:summary item))
-          nil)))))
-
-
-
+  (look [this arguments-str]
+    (let [arguments (extract-arguments arguments-str)]
+      (if (empty? arguments)
+        (:summary (get player :room))
+        (if (= "at" (first arguments))
+          (if-let [item (item this (second arguments))]
+            (:summary item)))))))

 (defn init-story [story-str]
   (let [raw-env (interpreter/interpret


Update docstring of extract-item-name.

Update docstring of extract-item-name.

--- project/scrape-summitpost-data/src/scrape_summitpost_data/search_result.clj
+++ project/scrape-summitpost-data/src/scrape_summitpost_data/search_result.clj
@@ -85,8 +85,8 @@
        (map (partial str base-url))))

 (defn- extract-item-name
-  "Given a url to an item (such as a url returned by get-urls),
-  return the name of the item."
+  "Given a url to an item on summitpost (such as a mountain), return the name
+  of the item."
   [url]
   (nth (re-find (re-pattern (str base-url "/([^/]+)/.*")) url)
        1))


finish go tags and add meta images

finish go tags and add meta images

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -27,31 +27,51 @@
 (defn layout [view-data & content]
   [:html
    [:head
-    [:title "Precursor is a fast web app for prototyping — make simple stuff."]
+    [:title "Precursor—fast prototyping web app, makes collaboration easy."]
     [:meta {:charset    "utf-8"}]
-    [:meta {:http-equiv "X-UA-Compatible"     :content "IE=edge"}]
-    [:meta {:name       "description"         :content "Your wireframe should be easy to share with any developer on your team. Design fast with iPhone and iPad collaboration. Precursor is productive prototyping."}]
-    [:meta {:name       "viewport"            :content "width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no"}]
+    [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]

-    ;; TODO finish ogs
-    ;; [:meta {:name       "og:card"        :content "summary"}]
-    ;; [:meta {:name       "og:site"        :content "@prcrsr_app"}]
-    ;; [:meta {:name       "og:title"       :content "Precursor is a fast web app for prototyping."}]
-    ;; [:meta {:name       "og:description" :content "You can prototype product design wireframes with a fast and simple web app."}]
-    ;; [:meta {:name       "og:image"       :content ""}]
-    ;; [:meta {:name       "og:url"         :content "https://prcrsr.com/"}]
+    [:meta {:name       "description"     :content "Your wireframe should be easy to share with any developer on your team. Design fast with iPhone and iPad collaboration. Precursor is productive prototyping."}]

-    [:meta {:name       "twitter:card"        :content "summary"}]
-    [:meta {:name       "twitter:site"        :content "@prcrsr_app"}]
-    [:meta {:name       "twitter:title"       :content "Precursor is a fast web app for prototyping."}]
-    [:meta {:name       "twitter:description" :content "You can prototype product design wireframes with a fast and simple web app."}]
-    [:meta {:name       "twitter:image"       :content ""}] ; TODO
-    [:meta {:name       "twitter:url"         :content "https://prcrsr.com/"}]
+    [:meta {:name "viewport"                              :content "width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no"}]
+    [:meta {:name "apple-touch-fullscreen"                :content "yes"}]
+    [:meta {:name "apple-mobile-web-app-capable"          :content "yes"}]
+    [:meta {:name "apple-mobile-web-app-status-bar-style" :content "black"}]
+    [:meta {:name "apple-mobile-web-app-title"            :content "Precursor"}]
+    [:meta {:name "format-detection"                      :content "telephone=no"}]

-    [:link {:rel "icon" :href "/favicon.ico" :type "image/ico"}]
-    [:link {:rel        "apple-touch-icon"    :href    "/apple-touch-icon.png"}]
-    [:link {:rel        "stylesheet"          :href    (pc.assets/asset-path "/css/app.css")}]
-    [:link {:rel        "stylesheet"          :href    "https://fonts.googleapis.com/css?family=Roboto:500,900,100,300,700,400"}]
+    ;; TODO make the rest of these startup images
+    [:link {:href  "750x1294.png" :rel "apple-touch-startup-image" :media "(device-width: 375px) and (device-height: 667px) and (orientation:  portrait) and (-webkit-device-pixel-ratio: 2)"}]
+    [:link {:href "1242x2148.png" :rel "apple-touch-startup-image" :media "(device-width: 414px) and (device-height: 736px) and (orientation:  portrait) and (-webkit-device-pixel-ratio: 3)"}]
+    [:link {:href "2208x1182.png" :rel "apple-touch-startup-image" :media "(device-width: 414px) and (device-height: 736px) and (orientation: landscape) and (-webkit-device-pixel-ratio: 3)"}]
+
+    [:meta {:name "og:card"         :content "summary"}]
+    [:meta {:name "og:description"  :content "Precursor lets you prototype product design wireframes with a fast and simple web app."}]
+    [:meta {:name "og:image"        :content "/img/precursor-logo.png"}]
+    [:meta {:name "og:image:width"  :content "1200"}]
+    [:meta {:name "og:image:height" :content "1200"}]
+    [:meta {:name "og:site_name"    :content "Precursor"}]
+    [:meta {:name "og:title"        :content "Fast prototyping web app, makes collaboration easy."}]
+    [:meta {:name "og:type"         :content "website"}]
+    [:meta {:name "og:url"          :content "https://prcrsr.com/"}]
+
+    [:meta {:name "twitter:card"         :content "summary_large_image"}]
+    [:meta {:name "twitter:description"  :content "Precursor lets you prototype product design wireframes with a fast and simple web app."}]
+    [:meta {:name "twitter:image:src"    :content "/img/precursor-logo.png"}]
+    [:meta {:name "twitter:image:width"  :content "1200"}]
+    [:meta {:name "twitter:image:height" :content "1200"}]
+    [:meta {:name "twitter:site"         :content "@prcrsr_app"}]
+    [:meta {:name "twitter:site:id"      :content "2900854766"}]
+    [:meta {:name "twitter:title"        :content "Fast prototyping web app, makes collaboration easy."}]
+    [:meta {:name "twitter:url"          :content "https://prcrsr.com/"}]
+
+    [:link {:rel "icon"             :href "/favicon.ico"}]
+    [:link {:rel "apple-touch-icon" :href "/img/apple-touch-icon.png"}]
+    [:link {:rel "stylesheet"       :href (pc.assets/asset-path "/css/app.css")}]
+    [:link {:rel "stylesheet"       :href "https://fonts.googleapis.com/css?family=Roboto:500,900,100,300,700,400"}]
+
+    [:style "html{-webkit-text-size-adjust:100%}"] ; prevents resizing when launching from ios home screen
+
     (embed-json-in-head "window.Precursor" (json/encode view-data))
     (when (prod-assets?)
       scripts/google-analytics)


process time count refacto

process time count refacto

--- src/sandbox/multithread.clj
+++ src/sandbox/multithread.clj
@@ -214,29 +214,20 @@
     (cycle procs-pattern)))
 ;;=> Generates an infinite sequence like we described above.

-(defn process-sequential-time
-  [a-process]
-  (let [instructions (a-process :instructions)
-        inst-types (map :inst-type instructions)
-        lengths (map #(get insts-effort %) inst-types)]
-    (reduce + lengths)))
-;;=> We get instruction-types, grab the efforts from the "insts-
-;; effort"
-;;   map and sum them all up using reduce.
-
-(defn schedule-programs
-  [language programs]
-;;=> programs are maps : {:program "the textual program",
-;;  :process-id the-process-id
-;;  :priority the-process-priority }
+(defn total-time [processes]
+  (->> (ps->is processes)
+       (map :inst-type)
+       (map insts-effort)
+       (reduce +)
+       (* 2)))
+
+(defn schedule-programs [language programs]
   (let [processes (into [] (map #(fire-a-process language
                                                  (:program %)
                                                  (:process-id %)
                                                  (:priority %))
                                 programs))
-;;=> Processes are constructed
-        timeout (* 2 (reduce + (map process-sequential-time
-                                    processes)))
+        timeout (total-time processes)
 ;;=> "timeout" is the total length of all processes executed one
 ;;   after the other.
         locks (ref (prepare-locks processes))


improve reconciliation search criteria handling

--- src/clj/clj_money/api/reconciliations.clj
+++ src/clj/clj_money/api/reconciliations.clj
@@ -5,6 +5,7 @@
             [dgknght.app-lib.core :refer [update-in-if
                                      parse-int
                                      uuid]]
+            [dgknght.app-lib.dates :refer [symbolic-comparatives]]
             [dgknght.app-lib.web :refer [unserialize-date]]
             [dgknght.app-lib.authorization
              :as auth
@@ -18,7 +19,10 @@
 (defn- extract-criteria
   [{:keys [params authenticated]}]
   (-> params
-      (select-keys [:account-id :status])
+      (update-in-if [:end-of-period-or-before] unserialize-date) ; TODO: include all posibilities
+      (update-in-if [:end-of-period-or-after] unserialize-date)
+      (symbolic-comparatives :end-of-period)
+      (select-keys [:account-id :status :end-of-period])
       (+scope ::models/reconciliation authenticated)))

 (defn- translate-sort


Added comments to api namespace.

Added comments to api namespace.

--- src/clj_formal_specifications_app/api.clj
+++ src/clj_formal_specifications_app/api.clj
@@ -4,11 +4,13 @@
             [clojure.string :as str]))

 (defn example-listing
+  "Returns names of all possible examples."
   []
   {:body (map examples/example
               (examples/files-in-classpath examples/example-dir))})

 (defn example-file
+  "Returns the contents of an example specification by filename."
   [filename]
   {:body {:contents (slurp (examples/example-file filename))}})

@@ -17,6 +19,9 @@
   {:body (.getMessage e) :status 400})

 (defn compose
+  "Expects spec to be a formal specification with ns form in the beginning.
+  If the namespace exists, erases it. Then evaluates the spec and returns
+  the namespace used in the specification."
   [spec]
   (let [ns (spec/get-ns-name spec)]
     (try
@@ -24,6 +29,9 @@
       (catch Exception e (bad-request e)))))

 (defn export
+  "Expects spec to be a formal specification with ns form in the beginning.
+  Returns a map of the formal specification, where filename is parsed from
+  the ns form in spec."
   [spec]
     {:body {:filename (if-let [ns (spec/get-ns-name spec)]
                         (str (peek (str/split ns #"\.")) ".clj")
@@ -31,6 +39,9 @@
             :contents spec}})

 (defn execute-with-ns
+  "Evaluates command, which should be a valid Clojure form with execute or
+  execute-init, in a namepace ns. Returns the result of the evaluation as
+  string."
   [ns command]
   (try
     {:body (str (binding [*ns* (find-ns (symbol ns))] (load-string command)))}


move subjunctive patterns to .edn

move subjunctive patterns to .edn

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -109,88 +109,16 @@

 ;; </passato>

-(defonce patterns-present-subjunctive
-  (compile-patterns
-   {:synsem {:infl :subjunctive}}
-   [{:agr {:synsem {:subcat {:1 {:agr {:number :sing
-                                       :person :1st}}}}}
-     :p [
-         #"(.*)i$"         "$1are"
-         #"(.*)a$"         "$1ere"
-         #"(.*)isca$"      "$1ire"
-         #"(.*)a$"         "$1ire"
-         #"(.*)i$"         "$1arsi" ;; alzi -> alzarsi
-         #"(.*)a$"         "$1irsi" ;; diverta -> divertirso
-         #"(.*)ica$"       "$1ire"  ;; dica -> dire
-         ]}
-    {:agr {:synsem {:subcat {:1 {:agr {:number :sing
-                                       :person :2nd}}}}}
-     :p [
-         #"(.*)i$"         "$1are"     ;; lavi -> lavare
-         #"(.*)i$"         "$1iare"    ;; studi -> studiare
-         #"(.*)i$"         "$1arsi"    ;; lavi -> lavarsi
-         #"(.*)cci$"       "$1cciare"  ;; abbracci -> abbracciare
-         #"(.*)a$"         "$1ere"     ;; scriva -> scrivere
-         #"(.*)a$"         "$1ire"     ;; senta -> sentire
-         #"(.*c)hi$"       "$1are"     ;; cerchi -> cercare
-         #"(.*)i$"         "$1iarsi"   ;; arrabbi -> arrabbiarsi
-         #"(.*)sca$"       "$1re"      ;; finisca -> finire
-         #"(.*)a$"         "$1irsi"    ;; diverta -> divertirsi
-         #"(.*)ica$"       "$1ire"     ;; dica -> dire
-         #"(.*)hi$"        "$1are"     ;; pieghi -> piegare
-         ]}
-
-    {:agr {:synsem {:subcat {:1 {:agr {:number :sing
-                                       :person :3rd}}}}}
-
-     :p [
-         #"(.*)i$"         "$1are"
-         #"(.*)a$"         "$1ere"
-         #"(.*)a$"         "$1ire"
-         #"(.*)i$"         "$1arsi"  ;; prepari -> preperarsi
-         #"(.*)sca$"       "$1re"    ;; finisca -> finire
-         #"(.*)ta$"        "$1tirsi" ;; diverta -> divertirsi
-         #"(.*)ica$"       "$1ire"   ;; dica -> dire
-         ]}
-
-    {:agr {:synsem {:subcat {:1 {:agr {:number :plur
-                                       :person :1st}}}}}
-     :p [
-         #"(.*)iamo$"      "$1are"   ;; parliamo -> parlare
-         #"(.*)iamo$"      "$1iare"  ;; mangiamo -> mangiare
-         #"(.*)iamo$"      "$1ere"
-         #"(.*)iamo$"      "$1ire"
-         #"(.*c)hiamo$"    "$1are"   ;; sprechiamo -> sprecare
-         #"(.*)iamo$"      "$1iarsi" ;; arrabiamo -> arrabiarsi
-         #"(.*)iamo$"      "$1arsi"  ;; chiamiamo -> chiamarsi
-         #"(.*)iamo$"      "$1irsi"  ;; divertiamo -> divertirsi
-         #"(.*)ciamo$"     "$1re"    ;; diciamo -> dire
-         #"(.*)hiamo$"     "$1are"   ;; pieghiamo -> piegare
-         ]}
-
-    {:agr {:synsem {:subcat {:1 {:agr {:number :plur
-                                       :person :2nd}}}}}
-     :p [
-         #"(.*)iate$"  "$1are"  ;; parliate -> parlare
-         #"(.*)iate$"  "$1ere"  ;; scriviate -> scrivere
-         #"(.*)iate$"  "$1ire"  ;; dormiate -> dormire
-         #"(.*)iate$"  "$1arsi" ;; chiamate -> chiamarsi
-         #"(.*)iate$"  "$1ersi" ;; mettiate -> metterrsi
-         #"(.*)iate$"  "$1irsi" ;; divertiate -> divertirsi
-         ]}
-
-    {:agr {:synsem {:subcat {:1 {:agr {:number :plur
-                                       :person :3rd}}}}}
-     :p [
-         #"(.*)ino$"       "$1are"
-         #"(.*)ano$"       "$1ere"
-         #"(.*)ano$"       "$1ire"
-         #"(.*)ino$"       "$1arsi" ;; alzino -> alzarsi
-         #"(.*)scano$"     "$1re"   ;; finiscano -> finire
-         #"(.*)ano$"       "$1irsi" ;; divertano -> divertirsi
-         #"(.*)cano$"      "$1re"   ;; dicano -> dire
-         #"(.*)ano$"       "$1irsi" ;; vestano -> vestirsi
-         ]}]))
+;; <subjunctive>
+(let [source
+      (-> (clojure.java.io/resource "babel/italiano/morphology/verbs/subjunctive.edn")
+          slurp
+          read-string)]
+  (def patterns-subjunctive
+    (compile-patterns
+     {:synsem {:infl :past}}
+     source)))
+;; </subjunctive>

 (defonce patterns-gerund
  (compile-patterns
@@ -215,8 +143,8 @@
         patterns-gerund
         patterns-imperfect
         patterns-past
-        patterns-present-subjunctive
-        patterns-present)))
+        patterns-present
+        patterns-subjunctive)))

 (defonce exceptions-rules
   [;; 1. past-tense exceptions


fix binary payload coercion

fix binary payload coercion

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -90,6 +90,8 @@
 (defn- body-to-string [body]
   (cond (instance? Element body) (emit-str body)
         (coll? body) (json/generate-string body)
+        (string? body) body
+        (nil? body) ""
         :else "(binary)"))

 (defn print-curl-request [req]
@@ -138,13 +140,15 @@
     ldiff))

 (defn coerce-payload [payload content-type]
-  (try (condp re-find (or content-type "")
+  (try (condp re-find (or content-type "json")
          #"xml" (parse-str payload)
          #"text" payload
-         (json->clj payload))
+         #"json" (json->clj payload)
+         nil)
        (catch Exception e
-         (log/error e "failed coercing payload" (body-to-string payload))
-         (body-to-string payload))))
+         (let [body-str (body-to-string payload)]
+           (log/error e "failed coercing payload" body-str)
+           body-str))))

 (def conn-mgr (delay (make-reusable-conn-manager {:insecure? true})))


texture object cache

texture object cache

--- src/cljs/infinitelives/pixi/texture.cljs
+++ src/cljs/infinitelives/pixi/texture.cljs
@@ -3,3 +3,26 @@

 (defn sub-texture [texture [x y] [w h]]
   (PIXI/Texture. texture (PIXI/Rectangle. x y w h)))
+
+(defonce texture-store (atom {}))
+
+(defn add!
+  [key texture]
+  (swap! texture-store assoc key texture)
+  )
+
+(defn remove!
+  ([key]
+   (swap! texture-store dissoc key)))
+
+(defn get
+  [key]
+  (@texture-store key))
+
+(defn load-sprite-sheet!
+  [texture asset-description]
+  (swap! texture-store
+         #(into %
+                (for [[key {:keys [pos size]}] asset-description]
+                  [key
+                   (sub-texture texture pos size)]))))


Extracted x-axis-path into a component

Extracted x-axis-path into a component

--- src/cljs/load_test_client/histogram.cljs
+++ src/cljs/load_test_client/histogram.cljs
@@ -30,10 +30,13 @@
                           :textAnchor "middle"}
                      (when (pos? (.-y bar)) (.-y bar))))))

-(defn render-x-axis-path [x-scale]
-  (let [rng (.range x-scale)]
-    (dom/path #js {:className "domain"
-                   :d (str "M0" (aget rng 0) ",6V0H" (aget rng 1) "V6")})))
+(defn x-axis-path-component [scale]
+  (reify
+    om/IRender
+    (render [_]
+      (let [rng (.range scale)]
+        (dom/path #js {:className "domain"
+                       :d (str "M0" (aget rng 0) ",6V0H" (aget rng 1) "V6")})))))

 (defn render-x-axis-ticks [x-scale]
   (let [ticks (.apply (.-ticks x-scale) x-scale)]
@@ -48,7 +51,7 @@
     om/IRender
     (render [_]
       (dom/g #js {:className "x axis" :transform (str "translate(0," chart-height ")")}
-             (render-x-axis-path scale)
+             (om/build x-axis-path-component scale)
              (render-x-axis-ticks scale)))))

 (defn component [{:keys [data-points]} owner]


#28 change load-md

#28 change load-md

--- src/tamaki/template/page.clj
+++ src/tamaki/template/page.clj
@@ -20,7 +20,7 @@
           output (new StringWriter)
           metadata (md/md-to-html input output :parse-meta? true :heading-anchors true)
           body (.toString output)]
-      (merge {:body body} {:metadata (merge metadata {:title (-> metadata :title first)
+      (merge {:body body :src md} {:metadata (merge metadata {:title (-> metadata :title first)
                                                       :link (-> metadata :link first)
                                                       :template (-> metadata :template first)})}))))


Added inc-frequencies and find-num functions.

--- src/lottery_prophet/core.clj
+++ src/lottery_prophet/core.clj
@@ -71,7 +71,20 @@

 (defn filter-rows-containing-num
   [nums n]
-  (filter #(some #{n} %) nums))
+  (filter #(some #{n} %) nums))
+
+(defn find-num
+  [nums n]
+  (first (drop-while #(not (== n (first %))) nums)))
+
+(defn inc-frequencies
+  [numbers inc-numbers]
+  (let [increase-if-matches (fn [[num freq] i-nums]
+                              (let [[i-num i-freq] (find-num i-nums num)]
+                              (if (nil? i-num)
+                                (vector num freq)
+                                (vector num (+ freq i-freq)))))]
+    (map #(increase-if-matches % inc-numbers ) numbers )))
 ;(def original-data (read-resource "data/original.htm"))
 ;(def preprocessed-data (find-lottery-lines original-data))
 ;(def cleaned-data (clean-data preprocessed-data))
@@ -80,12 +93,9 @@

 (def lottery-numbers (map remove-from-plus lottery-data))
 (def final-data (map str->int-seq lottery-numbers))
-(def frequency-set #{})
-

 (def number-frequencies (sort (freqs final-data)))
 (def freq-count (reduce + 0 (map second number-frequences)))
-;(def normalized-numbers (sort (normalize number-frequences)))

 (def accumulated-number-frequencies (add-acc number-frequencies))


Nicer layout

Nicer layout

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -21,17 +21,14 @@

 (def ct-validations
   {:vmid [(required) (numeric)]
-   :ostemplate [(required)]; string
+   :ostemplate [str? (required)]
    :cpus [(numeric)] :disk [(numeric)] :memory [(numeric)]
-   :ip_address [(required)]
-   :password [(required)]
-   :hostname [(required)]
-   :hypervisor [str?]
+   :ip_address [str? (required)]
+   :password [str? (required)]
+   :hostname [str? (required)]
+   :hypervisor [str? (required)]
    :features [vec?]
    })
-
-(def create-subset
-  (dissoc ct-validations [:features :hypervisor]))

 (def node-available?
   "Node availability check, result is cached for one minute"
@@ -85,8 +82,8 @@
   (create [this]
           (debug "creating" (:vmid spec))
           (try+
-            (check-task node (prox-post (str "/nodes/" node "/openvz")
-                                        (apply dissoc spec [:features :hypervisor])))
+            (let [cleanend-spec (apply dissoc spec [:features :hypervisor])]
+               (check-task node (prox-post (str "/nodes/" node "/openvz") )))
             ; TODO enable this later
             ;(enable-features this spec)
             (catch [:status 500] e


update set-value! & update-value! to immediately signal! after change

--- src/thi/ng/fabric/async.cljc
+++ src/thi/ng/fabric/async.cljc
@@ -16,7 +16,9 @@
   (score-collect [_])
   (signal! [_])
   (score-signal [_])
-  (receive-signal [_ src sig]))
+  (receive-signal [_ src sig])
+  (set-value! [_ val])
+  (update-value! [_ f]))

 (defprotocol IComputeGraph
   (add-vertex! [_ vstate])
@@ -62,6 +64,10 @@
   (deref
     [_] (:val @state))
   IVertex
+  (set-value!
+    [_ val] (swap! state assoc :val val) (signal! _) _)
+  (update-value!
+    [_ f] (swap! state update :val f) (signal! _) _)
   (collect!
     [_]
     ((::collect-fn @state) _)


conform to new error message format

conform to new error message format

--- src/metabase/api/meta/db.clj
+++ src/metabase/api/meta/db.clj
@@ -58,15 +58,17 @@
   {host Required
    port Required}
   (let [details (assoc details :engine (keyword engine))
-        response-invalid (fn [m] {:status 400 :body {:valid false :message m}})]
+        response-invalid (fn [field m] {:status 400 :body {:valid false
+                                                          field m        ; work with the new {:field error-message} format
+                                                          :message m}})] ; but be backwards-compatible with the UI as it exists right now
     (try
       (cond
         (driver/can-connect-with-details? details) {:valid true}
-        (u/host-port-up? host port)                (response-invalid "Invalid connection details")
-        (u/host-up? host)                          (response-invalid "Invalid port")
-        :else                                      (response-invalid "Host not reachable"))
+        (u/host-port-up? host port)                (response-invalid :dbname "Invalid connection details")
+        (u/host-up? host)                          (response-invalid :port "Invalid port")
+        :else                                      (response-invalid :host "Host not reachable"))
       (catch Throwable e
-        (response-invalid (.getMessage e))))))
+        (response-invalid :dbname (.getMessage e))))))

 (defendpoint GET "/:id"
   "Get `Database` with ID."


Comment fiddling

Comment fiddling

--- src/re_frame/events.cljc
+++ src/re_frame/events.cljc
@@ -12,7 +12,8 @@

 (defn- flatten-and-remove-nils
   "`interceptors` might have nested collections, and contain nil elements.
-  return a flat collection, with all nils removed."
+  return a flat collection, with all nils removed.
+  This function is 9/10 about giving good error messages"
   [id interceptors]
   (let [make-chain  #(->> % flatten (remove nil?))]
     (if-not debug-enabled?
@@ -31,10 +32,11 @@

 (defn register
-  "Associate given `event id` with the given collection of interceptors.
+  "Associate the given event `id` with the given collection of `interceptors`.

-   `interceptors` may have nested collections and may contain nils, so process them
-   into a nice linear collection before registration.
+   `interceptors` may contain nested collections and there may be nils
+   at any level,so process this sturcuture into a simple, nil-less vector
+   before registration.

    An `event handler` will likely be at the end of the chain (wrapped in an interceptor)."
   [id interceptors]


Improve page options decoding.

Improve page options decoding.

--- src/uxbox/services/pages.clj
+++ src/uxbox/services/pages.clj
@@ -18,6 +18,7 @@
             [uxbox.services.auth :as usauth]))

 (declare decode-page-data)
+(declare decode-page-options)

 ;; --- Create Page

@@ -45,7 +46,8 @@
               height layout data options]]
     (->> (sc/fetch-one conn sqlv)
          (usc/normalize-attrs)
-         (decode-page-data))))
+         (decode-page-data)
+         (decode-page-options))))

 (defmethod usc/-novelty :create/page
   [conn {:keys [data] :as params}]
@@ -71,7 +73,8 @@
               version options id user project]]
     (some-> (sc/fetch-one conn sqlv)
             (usc/normalize-attrs)
-            (decode-page-data))))
+            (decode-page-data)
+            (decode-page-options))))

 (defmethod usc/-novelty :update/page
   [conn {:keys [data] :as params}]
@@ -95,7 +98,8 @@
               version options id user project]]
     (some-> (sc/fetch-one conn sqlv)
             (usc/normalize-attrs)
-            (decode-page-data))))
+            (decode-page-data)
+            (decode-page-options))))

 (defmethod usc/-novelty :update/page-metadata
   [conn params]
@@ -120,6 +124,8 @@
   (delete-page conn params))

 ;; --- List Pages
+
+;; TODO: consider using transducers

 (defn get-pages-for-user
   [conn user]
@@ -128,12 +134,12 @@
                  " ORDER BY created_at ASC")]
     (->> (sc/fetch conn [sql user])
          (map usc/normalize-attrs)
-         (map decode-page-data))))
+         (map decode-page-data)
+         (map decode-page-options))))

 (defmethod usc/-query :list/pages
   [conn {:keys [user] :as params}]
   (get-pages-for-user conn user))
-

 ;; --- List Pages by Project

@@ -148,7 +154,8 @@
                  " ORDER BY created_at ASC")]
     (->> (sc/fetch conn [sql user project])
          (map usc/normalize-attrs)
-         (map decode-page-data))))
+         (map decode-page-data)
+         (map decode-page-options))))

 (defmethod usc/-query :list/pages-by-project
   [conn {:keys [user project] :as params}]
@@ -206,22 +213,26 @@

 ;; --- Helpers

+(defn- decode-page-options
+  [{:keys [options] :as result}]
+  (let [options (some-> options
+                        (codecs/str->bytes)
+                        (t/decode))]
+    (assoc result :options options)))
+
 (defn- decode-page-data
-  [{:keys [data options] :as result}]
+  [{:keys [data] :as result}]
   (let [data (some-> data
                      (codecs/str->bytes)
-                     (t/decode))
-        options (some-> options
-                        (codecs/str->bytes)
-                        (t/decode))]
-
-    (assoc result :data data :options options)))
+                     (t/decode))]
+    (assoc result :data data)))

 (defn get-page-by-id
   [conn id]
   (let [sqlv ["SELECT * FROM pages WHERE id=?" id]]
     (some-> (sc/fetch-one conn sqlv)
             (usc/normalize-attrs)
-            (decode-page-data))))
-
-
+            (decode-page-data)
+            (decode-page-options))))
+
+


Duplicate agos-chan.

Duplicate agos-chan.

--- src/rewindable/agos.cljs
+++ src/rewindable/agos.cljs
@@ -80,9 +80,3 @@
   (println :agos-return-chan (sstate state) value)
   (cljs.core.async.impl.ioc-helpers/return-chan state value))

-(defn agos-chan [buf]
-  (println :agos-chan buf)
-  (channels/ManyToManyChannel. (uverse-buf (make-uverse)) 0
-                               (uverse-buf (make-uverse)) 0
-                               buf false))
-


update-wish-rem cljs

update-wish-rem cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -93,6 +93,10 @@
     (letrem [neu (create-wish clean)]
       (read-wishlist-rem (get-path)))))

+(defn update-wish-rem [$elem]
+  (let [wish (wish-from-elem $elem)]
+    (letrem [neu (update-wish wish)]
+      (fn [e] nil))))

 ; DELEGATES