some data science bamboozle

some data science bamboozle

--- src/clj/ceres/curator.clj
+++ src/clj/ceres/curator.clj
@@ -6,26 +6,25 @@
             [clojure.data.json :as json]
             [monger.joda-time]
             [clojure.string :refer [split join]]
-            [taoensso.timbre :as timbre]
             [clojure.walk :as walk]
             [clojure.zip :as zip]
             [clj-time.core :as t]
             [clj-time.format :as f]
-            [clj-time.coerce :as c]
-            [clojure.pprint :refer [pprint]]
-            [clojure.java.shell :refer [sh]]
+            [clj-time.coerce :as c] [clj-time.periodic :as p] [clojure.pprint :refer [pprint]] [clojure.java.shell :refer [sh]]
             [opennlp.nlp :refer [make-tokenizer make-detokenizer]]
+            [incanter.core :refer :all]
+            [incanter.stats :refer :all]
+            [incanter.charts :refer :all]
             [ceres.collector :refer [db custom-formatter news-accounts store]])
  (:import org.bson.types.ObjectId))

-(timbre/refer-timbre)

 (defrecord Source [name articles])
 (defrecord Article [source tweet reactions])
 (defrecord Reaction [tweet reactions])

-#_(def tokenize (make-tokenizer "/home/konny/data/open-nlp/de-token.bin"))
+#_(def tokenize (make-tokenizer "data/de-token.bin"))

 ;; --- DATA MINING ---

@@ -163,20 +162,18 @@
   [tree]
   (loop [pub-time (-> (zip/root tree) :source :ts)
          hashtags []
-       ;;  tokens []
+         tokens []
          loc tree]
     (if (zip/end? loc)
       {:root (zip/root loc)
-       ;; :tokens nil (frequencies tokens)
+       :tokens (frequencies tokens)
        :hashtags (frequencies (map :text hashtags))}
       (recur
        pub-time
        (if-let [node (zip/node loc)]
          (->> node :tweet :entities :hashtags (into hashtags))
          hashtags)
-       #_(if (zip/node loc)
-         (conj tokens (clojure.set/difference (into #{} (-> loc zip/node :tweet :text tokenize)) (first tokens)))
-         tokens)
+       (if (zip/node loc) (conj tokens (clojure.set/difference (into #{} (-> loc zip/node :tweet :text tokenize)) (first tokens))) tokens)
        (if (nil? (zip/node loc))
          (zip/next loc)
          (zip/next
@@ -217,7 +214,7 @@
        (zip/next loc)))))

 (defn compute-impact-forest [source]
-  (let [source-origins (mc/find-maps db "origins" {:source source})]
+  (let [source-origins (mc/find-maps @db "origins" {:source source})]
     (vec (pmap compute-impact-tree source-origins))))

@@ -228,17 +225,12 @@
      :size (compute-dfs tree)}))

-(defn random-tree []
-  (let [tree (-> (mc/find-maps @db "origins" {:source {$in news-accounts}}) rand-nth compute-impact-tree)]
-    {:graph (simplify-tree tree)
-     :height (tree-height tree)
-     :size (compute-dfs tree)}))
-
-
 (defn analyze-tree [tree]
   (loop [counter 0
          max-path 0
          users []
+         ;; tokens []
+         pub-times []
          hashtags []
          delays []
          loc tree]
@@ -246,7 +238,9 @@
       {:size counter
        :height max-path
        :users users
-       :hashtags (vec (into #{} (map :text hashtags)))
+       ;;:tokens tokens
+       :pub-times pub-times
+       :hashtags (mapv #(-> % :text clojure.string/lower-case) hashtags)
        :delays delays}
       (recur
        (if (zip/node loc)
@@ -257,8 +251,12 @@
          max-path)
        (if-let [node (zip/node loc)]
          (let [user (-> node :tweet :user)]
-             (conj users (-> {:name (:screen_name user) :followers (:followers_count user)})))
+             (conj users (:screen_name user)))
          users)
+       #_(if (zip/node loc) (conj tokens (clojure.set/difference (into #{} (-> loc zip/node :tweet :text tokenize)) (first tokens))) tokens)
+       (if-let [node (zip/node loc)]
+         (->> node :tweet :created_at (conj pub-times))
+         pub-times)
        (if-let [node (zip/node loc)]
          (->> node :tweet :entities :hashtags (into hashtags))
          hashtags)
@@ -267,23 +265,40 @@
                post-delay (if (t/after? (-> loc zip/node :tweet :created_at) pub-time)
                             (t/interval pub-time (-> loc zip/node :tweet :created_at))
                             (t/interval (-> loc zip/node :tweet :created_at) pub-time))]
-           (conj delays (t/in-hours post-delay)))
+           (conj delays (t/in-seconds post-delay)))
          delays)
        (zip/next loc)))))
+
+
+(defn random-tree []
+  (let [origin (rand-nth (mc/find-maps @db "origins" {:source {$in news-accounts}}))
+        tree (-> origin compute-impact-tree)]
+    [(:title (mc/find-map-by-id @db "articles" (:article origin)))
+     (analyze-tree tree)]))

 (defn compute-summary [source]
   (let [impact-forest (compute-impact-forest source)
         analytics (map analyze-tree impact-forest)
         sizes (map :size analytics)
+        pub-times (map :pub-times analytics)
         heights (map :height analytics)
-        users (frequencies (flatten (map :users analytics)))
-        hashtags (frequencies (flatten (map :hashtags analytics)))
+        delays (apply concat (map :delays analytics))
+        users (->> analytics
+                   (map :users)
+                   (apply concat))
+        hashtags (->> analytics
+                      (map :hashtags)
+                      flatten)
         overall-size (reduce + sizes)]
     {:source source
-     :articles (count impact-forest)
-     :top-users (take 50 (sort-by second > users))
-     :hastags (take 50 (sort-by second > hashtags))
+     :article-count (count impact-forest)
+     :users users
+     :hashtags hashtags
+     :pub-times pub-times
+     :heights heights
+     :sizes sizes
+     :delays delays
      :total-impact overall-size
      :avg-impact (float (/ overall-size (count sizes)))
      :no-reactions (float (/ (count (filter #(< % 1) heights)) (count heights)))
@@ -338,37 +353,61 @@
   (pprint (map compute-summary news-accounts))

-  (let [tree (-> (mc/find-maps db "origins" {:source {$in news-accounts}}) rand-nth compute-impact-tree)
-        ds (loop [pub-time (-> (zip/root tree) :source :ts)
-                  dates []
-                 loc tree]
-            (if (zip/end? loc)
-              dates
-              (recur
-               pub-time
-               (if (zip/node loc)
-                 (let [post-delay (if (t/after? (-> loc zip/node :tweet :created_at) pub-time)
-                                    (t/interval pub-time (-> loc zip/node :tweet :created_at))
-                                    (t/interval (-> loc zip/node :tweet :created_at) pub-time))]
-                   (conj dates (t/in-hours post-delay)))
-                 dates)
-               (zip/next loc))))]
-    ds)
-
-  (mc/count db "origins" {:source "SPIEGELONLINE"})
-
-  (-> (mc/find-maps db "origins" {:source {$in news-accounts}})
-      rand-nth
-      compute-impact-tree
-      analyze-tree
-      pprint)
+  (def rand-tree (random-tree))
+
+
+  (println "\n")
+
+
+
+  (def n-freq (get-news-frequencies))
+

   (-> (mc/find-maps @db "tweets" {:created_at {$gt (t/today)}})
       count
       time)

+  (def sum-tagesschau (compute-summary "tagesschau"))
+
+  (def sum-faz (compute-summary "FAZ_NET"))
+
+  (def sum-sz (compute-summary "SZ"))
+
+  (def sum-spon (compute-summary "SPIEGELONLINE"))
+
+  (def sum-welt (compute-summary "welt"))
+
+
+
+  (let [faz-hours (->> sum-faz
+                       :pub-times
+                       flatten
+                       (map t/hour)
+                       frequencies
+                       (sort-by key <))]
+    (view (line-chart (keys pub-hours) (vals pub-hours))))
+
+
+  (let [delays (->>  sum-faz
+                     :delays
+                     (remove #(= % 0))
+                     (remove #(> % 600)))]
+    (view (histogram delays :nbins 120)))
+
+
+  (let [hours-running (t/in-hours (t/interval (t/date-time 2014 7 2) (t/now)))
+        dates (take hours-running (p/periodic-seq (t/date-time 2014 7 2) (t/hours 1)))
+        tweet-count (map
+                     #(mc/count @db
+                                "tweets"
+                                {:created_at {$gte %
+                                              $lt (t/plus % (t/hours 1))}})
+                     dates)
+        days-since-start (range hours-running)]
+    (view (line-chart days-since-start tweet-count)))
+
+
+
   ;; twitter-nlp
   ;; html compression
-
-
-)
+  )


fix busted instance? cases

fix busted instance? cases

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1189,8 +1189,8 @@
   "Returns a path suitable for providing to tools.reader as a 'filename'."
   [x]
   (cond
-   (instance? File) (.getAbsolutePath ^File x)
-   (instance? java.net.URL) (-> ^java.net.URL x .toURI File. .getAbsolutePath)
+   (instance? File x) (.getAbsolutePath ^File x)
+   (instance? java.net.URL x) (-> ^java.net.URL x .toURI File. .getAbsolutePath)
    :default (str x)))

 (defn forms-seq


CLJS-328: fix :require spec handling in ns

Fixes singleton vector handling in :require specs so that all specs in
the following snippet are equivalent:

(ns foo
  (:require [bar.quux :as bar.quux]
            [bar.quux]
            bar.quux))

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -606,9 +606,9 @@
                                               (<= (fs :refer 0) 1)))
                                        (error-msg spec "Each of :as and :refer options may only be specified once in :require / :require-macros")))
                              (if (symbol? spec)
-                               (recur macros? [spec :as spec])
+                               (recur macros? [spec])
                                (let [[lib & opts] spec
-                                     {alias :as referred :refer} (apply hash-map opts)
+                                     {alias :as referred :refer :or {alias lib}} (apply hash-map opts)
                                      [rk uk] (if macros? [:require-macros :use-macros] [:require :use])]
                                  (assert (or (symbol? alias) (nil? alias))
                                          (error-msg spec ":as must be followed by a symbol in :require / :require-macros"))


remove unused dynamic var and related dead code

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -55,8 +55,6 @@
 (def ^:dynamic *cljs-source-map* nil)
 (def ^:dynamic *cljs-gen-col* nil)
 (def ^:dynamic *cljs-gen-line* nil)
-
-(def ^:dynamic *emitted-provides* nil)
 (def ^:dynamic *lexical-renames* {})
 (def cljs-reserved-file-names #{"deps.cljs"})

@@ -155,11 +153,6 @@

 (defn ^String emit-str [expr]
   (with-out-str (emit expr)))
-
-(defn emit-provide [sym]
-  (when-not (or (nil? *emitted-provides*) (contains? @*emitted-provides* sym))
-    (swap! *emitted-provides* conj sym)
-    (emitln "goog.provide('" (munge sym) "');")))

 (defmulti emit-constant class)
 (defmethod emit-constant nil [x] (emits "null"))
@@ -857,7 +850,6 @@
                    ana/*cljs-file* (.getPath ^File src)
                    reader/*alias-map* (or reader/*alias-map* {})
                    reader/*data-readers* tags/*cljs-data-readers*
-                   *emitted-provides* (atom #{})
                    *cljs-source-map* (when (:source-map opts) (atom (sorted-map)))
                    *cljs-gen-line* (atom 0)
                    *cljs-gen-col* (atom 0)]


Added toggle function

Added toggle function

--- src/clj_bots/pin_ctrl.clj
+++ src/clj_bots/pin_ctrl.clj
@@ -80,6 +80,16 @@
   ([pin val] (board-apply p/write-value! pin val))
   ([board pin-n val] (p/write-value! board pin-n val)))

+;; XXX Should we try to worry about race conditions here? Could make this lower level so read/write messages
+;; don't have anything inbetween interfere.
+(defn toggle!
+  "Toggle a GPIO pin between high and low."
+  ([pin] (board-apply pin toggle!))
+  ([board pin-n]
+   (let [current-val (read-value board pin-n)
+         new-val (if (= current-val :low) :high :low)]
+     (write-value! board pin-n new-val))))
+
 ;; ### Edge detection functionality

 (defn set-edge!


Shorten up some thread chains

Shorten up some thread chains

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -64,8 +64,7 @@
   from last-node to r node"
   (let [r-layer-id (inc (:layer-id last-node))
         [r-g r-node] (make-node graph r-layer-id {:characters characters})
-        g (-> r-g
-              (update-in [:rs] conj r-node)
+        g (-> (update-in r-g [:rs] conj r-node)
               (add-edge last-node r-node characters))]
     [g r-node]))

@@ -317,15 +316,13 @@
   of [order edge] pairs of the edge targets in the destination layer, using
   this edge ordering"
   [ordered next-ordered graph-edges]
-  (let [next-order-map (->> next-ordered
-                            (map-indexed #(-> [%2 %1]))
+  (let [next-order-map (->> (map-indexed #(-> [%2 %1]) next-ordered)
                             (into {}))
         ;; Edges between segment containers need to be counted as well
         ;; but they change with each new ordering, so we just temporarily
         ;; merge the current segment edges with the never-changing
         ;; node -> node edges
-        edges (->> next-ordered
-                   (filter vector?)
+        edges (->> (filter vector? next-ordered)
                    (map (juxt identity
                               (partial mapcat #(-> % :characters))))
                    (map (fn [[seg-c characters]]
@@ -391,8 +388,7 @@
                              #{}))
                   g (update-in graph [:marked] set/union marked)]
               (recur g tree parent-index c))
-            (let [t (-> tree
-                        (update-in [real-right-index :weight] + weight)
+            (let [t (-> (update-in tree [real-right-index :weight] + weight)
                         (cond->
                          is-seg-c (assoc-in [real-right-index :is-seg-c] true)
                          (not is-seg-c) (update-in [real-right-index :node-edges]
@@ -452,8 +448,7 @@
     (if (< num-succs 2)
       0
       (let [measures (:measures next-layer)
-            order-map (->> succs
-                           (sort-by #(get measures %))
+            order-map (->> (sort-by #(get measures %) succs)
                            (map-indexed (fn [idx n]
                                           (map #(-> [% idx])
                                                (:characters n))))
@@ -594,9 +589,8 @@
          layers (-> graph :layers rest)]
     (if (empty? layers)
       graph
-      (let [l (->> layer
-                   (replace-ps graph)
-                   set-positions)
+      (let [l (-> (replace-ps graph layer)
+                  set-positions)
             next-l (->> (first layers)
                         (set-qs-non-qs graph)
                         (set-measures graph l)
@@ -616,12 +610,10 @@
   "Set up the attributes the first layer in a sweep needs in order to serve
   as a basis for ordering the following layer"
   [graph seed-order]
-  (let [layer (-> graph
-                  :layers
+  (let [layer (-> graph :layers
                   (get 0)
                   (assoc :flat seed-order :ordered seed-order))]
-    (-> graph
-        (assoc-in [:layers 0] layer)
+    (-> (assoc-in graph [:layers 0] layer)
         (neighborify layer)
         (indexify layer))))


CMR-3195: Used are3 to combine the tests

--- system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_validation_test.clj
@@ -1,25 +1,27 @@
 (ns cmr.system-int-test.ingest.collection-validation-test
   "CMR Ingest validation integration tests"
-  (:require [clojure.test :refer :all]
-            [cmr.system-int-test.utils.ingest-util :as ingest]
-            [cmr.system-int-test.data2.collection :as dc]
-            [cmr.system-int-test.data2.granule :as dg]
-            [cmr.system-int-test.data2.core :as d]
-            [cmr.common.mime-types :as mt]
-            [cmr.umm.umm-collection :as c]
-            [cmr.umm.umm-spatial :as umm-s]
-            [cmr.common.util :refer [are2]]
-            [cmr.common-app.test.side-api :as side]
-            [cmr.spatial.polygon :as poly]
-            [cmr.spatial.point :as p]
-            [cmr.spatial.line-string :as l]
-            [cmr.spatial.mbr :as m]
-            [cmr.ingest.config :as icfg]
-            [cmr.ingest.services.messages :as msg]
-            [cmr.common.mime-types :as mime-types]
-            [cmr.system-int-test.utils.index-util :as index]
-            [cmr.system-int-test.utils.search-util :as search]
-            [clojure.java.io :as io]))
+  (:require
+    [clojure.test :refer :all]
+    [cmr.system-int-test.utils.ingest-util :as ingest]
+    [cmr.system-int-test.data2.collection :as dc]
+    [cmr.system-int-test.data2.granule :as dg]
+    [cmr.system-int-test.data2.core :as d]
+    [cmr.common.mime-types :as mt]
+    [cmr.umm.umm-collection :as c]
+    [cmr.umm.umm-spatial :as umm-s]
+    [cmr.common.util :refer [are2]]
+    [cmr.common.util :as u :refer [are3]]
+    [cmr.common-app.test.side-api :as side]
+    [cmr.spatial.polygon :as poly]
+    [cmr.spatial.point :as p]
+    [cmr.spatial.line-string :as l]
+    [cmr.spatial.mbr :as m]
+    [cmr.ingest.config :as icfg]
+    [cmr.ingest.services.messages :as msg]
+    [cmr.common.mime-types :as mime-types]
+    [cmr.system-int-test.utils.index-util :as index]
+    [cmr.system-int-test.utils.search-util :as search]
+    [clojure.java.io :as io]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"}))

@@ -81,6 +83,16 @@
      (is (= {:status 422
              :errors [{:path field-path
                        :errors errors}]}
+            (select-keys response [:status :errors]))))))
+
+(defn assert-invalid-schema
+  ([coll-attributes errors]
+   (assert-invalid coll-attributes errors nil))
+  ([coll-attributes errors options]
+   (let [response (d/ingest "PROV1" (dc/collection coll-attributes)
+                            (merge {:allow-failure? true} options))]
+     (is (= {:status 422
+             :errors [errors]}
             (select-keys response [:status :errors]))))))

 (defn assert-invalid-keywords
@@ -346,82 +358,64 @@
     (assert-valid {:product-specific-attributes [(dc/psa {:name "bool1" :data-type :boolean :value true})
                                                  (dc/psa {:name "bool2" :data-type :boolean :value true})]}))

-  (testing "Enabling UMM-C JSON-Schema validation through Cmr-Validate-Umm-C header being true"
-    ;; create collection valid against echo10 but invalid against schema
-    (let [response (d/ingest "PROV1" (dc/collection {:product-specific-attributes
-                                                     [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                      (dc/psa {:name "bool2" :data-type :boolean :value true})]})
-                             {:allow-failure? true :validate-umm-c true})]
-      (is (= {:status 422
-              :errors ["object has missing required properties ([\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\"])"]}
-             (select-keys response [:status :errors]))))
-    (assert-valid {:product-specific-attributes [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                 (dc/psa {:name "bool2" :data-type :boolean :value true})]}))
-  (testing "Enabling UMM-C JSON-Schema validation through Cmr-Validate-Umm-C header being false"
-    ;; create collection valid against echo10 but invalid against schema
-    (let [response (d/ingest "PROV1" (dc/collection {:product-specific-attributes
-                                                     [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                      (dc/psa {:name "bool2" :data-type :boolean :value true})]})
-                             {:allow-failure? true :validate-umm-c false})]
-      (is (= {:status 200}
-             (select-keys response [:status :errors]))))
-    (assert-valid {:product-specific-attributes [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                 (dc/psa {:name "bool2" :data-type :boolean :value true})]}))
-  (testing "Enabling UMM-C JSON-Schema validation through Cmr-Validate-Umm-C header being absent"
-    ;; create collection valid against echo10 but invalid against schema
-    (let [response (d/ingest "PROV1" (dc/collection {:product-specific-attributes
-                                                     [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                      (dc/psa {:name "bool2" :data-type :boolean :value true})]})
-                             {:allow-failure? true})]
-      (is (= {:status 200}
-             (select-keys response [:status :errors]))))
-    (assert-valid {:product-specific-attributes [(dc/psa {:name "bool1" :data-type :boolean :value true})
-                                                 (dc/psa {:name "bool2" :data-type :boolean :value true})]}))
-
-  (testing "Enabling UMM-Spec validation through Cmr-Validate-Umm-C header being true"
-    ;; create a collection that's  valid against schema validation, but invalid against umm-spec validation
-    (assert-invalid
-      {:processing-level-id "1"
-       :science-keywords [(dc/science-keyword {:category "upcase"
-                                               :topic "Cool"
-                                               :term "Mild"})]
-       :spatial-coverage (dc/spatial {:gsr :cartesian})
-       :related-urls [(dc/related-url {:type "type" :url "http://www.foo.com"})]
-       :product-specific-attributes
-       [(dc/psa {:name "bool" :data-type :boolean :value true})
-        (dc/psa {:name "bool" :data-type :boolean :value true})]}
-      ["AdditionalAttributes"]
-      ["Additional Attributes must be unique. This contains duplicates named [bool]."]
-      {:validate-umm-c true}))
-  (testing "Enabling UMM-Spec validation through Cmr-Validate-Umm-C header being false"
-    ;; create a collection that's  valid against schema validation, but invalid against umm-spec validation
-    (assert-invalid
-      {:processing-level-id "1"
-       :science-keywords [(dc/science-keyword {:category "upcase"
-                                               :topic "Cool"
-                                               :term "Mild"})]
-       :spatial-coverage (dc/spatial {:gsr :cartesian})
-       :related-urls [(dc/related-url {:type "type" :url "http://www.foo.com"})]
-       :product-specific-attributes
-       [(dc/psa {:name "bool" :data-type :boolean :value true})
-        (dc/psa {:name "bool" :data-type :boolean :value true})]}
-      ["ProductSpecificAttributes"]
-      ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]
-      {:validate-umm-c false}))
-  (testing "Enabling UMM-Spec validation through Cmr-Validate-Umm-C header being absent"
-    ;; create a collection that's  valid against schema validation, but invalid against umm-spec validation
-    (assert-invalid
-      {:processing-level-id "1"
-       :science-keywords [(dc/science-keyword {:category "upcase"
-                                               :topic "Cool"
-                                               :term "Mild"})]
-       :spatial-coverage (dc/spatial {:gsr :cartesian})
-       :related-urls [(dc/related-url {:type "type" :url "http://www.foo.com"})]
-       :product-specific-attributes
-       [(dc/psa {:name "bool" :data-type :boolean :value true})
-        (dc/psa {:name "bool" :data-type :boolean :value true})]}
-      ["ProductSpecificAttributes"]
-      ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]))
+  ;; testing enabling umm json schema validation through Cmr-Validation-Umm-C header
+  (let [coll-attr {:product-specific-attributes
+                   [(dc/psa {:name "bool1" :data-type :boolean :value true})
+                    (dc/psa {:name "bool2" :data-type :boolean :value true})]}]
+    (side/eval-form `(icfg/set-return-umm-json-validation-errors! false))
+    (do (are3 [coll-attributes error options]
+              (do (assert-invalid-schema coll-attributes error options)
+                  (assert-valid coll-attributes))
+
+              "Set Cmr-Validate-Umm-C header to true - schema validation error is returned"
+              coll-attr
+              "object has missing required properties ([\"ProcessingLevel\",\"RelatedUrls\",\"ScienceKeywords\",\"SpatialExtent\"])"
+              {:validate-umm-c true})
+
+        (are3 [coll-attributes options]
+              (do (assert-valid coll-attributes options)
+                  (assert-valid coll-attributes))
+
+              "Set Cmr-Validate-Umm-C header to false - schema validation error is not returned"
+              coll-attr
+              {:allow-failure? true :validate-umm-c false}
+
+              "Do not set Cmr-Validate-Umm-C header - schema validation error is not returned"
+              coll-attr
+              {:allow-failure? true})))
+
+  ;; testing enabling umm-spec validation through Cmr-Validation-Umm-C header
+  (let [coll-attr {:processing-level-id "1"
+                   :science-keywords [(dc/science-keyword {:category "upcase"
+                                                           :topic "Cool"
+                                                           :term "Mild"})]
+                   :spatial-coverage (dc/spatial {:gsr :cartesian})
+                   :related-urls [(dc/related-url {:type "type" :url "http://www.foo.com"})]
+                   :product-specific-attributes
+                   [(dc/psa {:name "bool" :data-type :boolean :value true})
+                    (dc/psa {:name "bool" :data-type :boolean :value true})]}]
+    (side/eval-form `(icfg/set-return-umm-json-validation-errors! false))
+    (side/eval-form `(icfg/set-return-umm-spec-validation-errors! false))
+    (are3 [coll-attributes field-path error options]
+          (assert-invalid coll-attributes field-path error options)
+
+          "Set Cmr-Validate-Umm-C header to true - schema validation passed, umm-spec validation error is returned"
+          coll-attr
+          ["AdditionalAttributes"]
+          ["Additional Attributes must be unique. This contains duplicates named [bool]."]
+          {:validate-umm-c true}
+
+          "Set Cmr-Validate-Umm-C header to false - schema validation passed, umm-spec validation error is not returned"
+          coll-attr
+          ["ProductSpecificAttributes"]
+          ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]
+          {:validate-umm-c false}
+
+          "Do not set Cmr-Validate-Umm-C header - schema validation passed, umm-spec validation error is not returned"
+          coll-attr
+          ["ProductSpecificAttributes"]
+          ["Product Specific Attributes must be unique. This contains duplicates named [bool]."]
+          nil))

   (side/eval-form `(icfg/set-return-umm-spec-validation-errors! true))

@@ -431,7 +425,7 @@
        [(dc/psa {:name "bool" :data-type :boolean :value true})
         (dc/psa {:name "bool" :data-type :boolean :value true})]}
       ["AdditionalAttributes"]
-      ["Additional Attributes must be unique. This contains duplicates named [bool]."]))
+      ["Additional Attributes must be unique. This contains duplicates named [bool]."]))
   (testing "Nested Path Validation"
     (assert-invalid
       {:platforms [(dc/platform {:instruments [(dc/instrument {:short-name "I1"})


Pull out frame logic from default code path - add new :target key which can take :frame and :perm-frame (for a frame permanently on top of other windows), and :applet for a non-frame-wrapped applet. This should make it easier to wrap the applet in other targets.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -33,50 +33,67 @@
   [applet]
   (.exit applet))

-(defn applet-close
-  "Stop the applet and close the window."
+(defn- applet-close-applet
+  [applet]
+  (.stop applet))
+
+(defn- applet-close-frame
   [applet]
   (let [closing-fn (fn []
-                     (let [frame @(:frame (meta applet))]
-                       (.stop applet)
+                     (let [frame @(:target-obj (meta applet))]
+                       (applet-close-applet applet)
                        ;;.destroy appears to kill the process too
                        (doto frame
                          (.hide)
                          (.dispose))))]
-    (javax.swing.SwingUtilities/invokeAndWait closing-fn))  )
+    (javax.swing.SwingUtilities/invokeAndWait closing-fn)))
+
+(defn applet-close
+  "Stop the applet and close the window."
+  [applet]
+  (case (:target (meta applet))
+    :frame      (applet-close-frame applet)
+    :perm-frame (applet-close-frame applet)
+    :applet     (applet-close-applet applet)))
+
+(defn- launch-applet-frame
+  [applet renderer keep-on-top?]
+  (let [truthify       #(not (or (nil? %) (false? %)))
+        keep-on-top?   (truthify keep-on-top?)
+        m              (.meta applet)
+        [width height] (or (:size m) [800 600])
+        close-op       JFrame/DISPOSE_ON_CLOSE
+        title          (or (:title m) (str "Quil " (swap! untitled-applet-id* inc)))
+        f              (JFrame. title)]
+    (doto f
+      (.addWindowListener  (reify WindowListener
+                             (windowActivated [this e])
+                             (windowClosing [this e]
+                               (future (applet-close applet)))
+                             (windowDeactivated [this e])
+                             (windowDeiconified [this e])
+                             (windowIconified [this e])
+                             (windowOpened [this e])
+                             (windowClosed [this e])))
+      (.setDefaultCloseOperation close-op)
+      (.setSize width height)
+      (.add applet)
+      (.pack))
+    (when (= renderer :opengl)
+      (.setResizable f false))
+    (.show f)
+    (.setAlwaysOnTop f keep-on-top?)
+    (reset! (:target-obj (meta applet)) f)
+    applet))

 (defn- applet-run
-  "Launches the applet."
-  ([applet] (applet-run applet nil false))
-  ([applet mode keep-on-top?]
-     (.init applet)
-     (let [m (.meta applet)
-           keep-on-top? (true? keep-on-top?)
-           [width height & _] (or (:size m) [200 200])
-           close-op (if (= :exit-on-close mode)
-                      JFrame/EXIT_ON_CLOSE
-                      JFrame/DISPOSE_ON_CLOSE)]
-       (reset! (:frame m)
-               (let [f (JFrame. (or (:title m) (str "Quil " (swap! untitled-applet-id* inc))))]
-                 (doto f
-                   (.addWindowListener  (reify WindowListener
-                                          (windowActivated [this e])
-                                          (windowClosing [this e]
-                                            (future (applet-close applet)))
-                                          (windowDeactivated [this e])
-                                          (windowDeiconified [this e])
-                                          (windowIconified [this e])
-                                          (windowOpened [this e])
-                                          (windowClosed [this e])))
-                   (.setDefaultCloseOperation close-op)
-                   (.setSize width height)
-                   (.add applet)
-                   (.pack))
-                 (when (= mode :opengl)
-                   (.setResizable f false))
-                 (.show f)
-                 (.setAlwaysOnTop f keep-on-top?)
-                 f)))))
+  "Launches the applet to the specified target."
+  [applet renderer target]
+  (.init applet)
+  (case target
+    :frame (launch-applet-frame applet renderer false)
+    :perm-frame (launch-applet-frame applet renderer true)
+    :applet applet))

 (def ^{:private true}
   renderer-modes {:p2d    P2D
@@ -86,8 +103,6 @@
                   :pdf    PDF
                   :dxf    DXF})

-
-
 (defn- applet-set-size
   ([width height] (.size *applet* (int width) (int height)))
   ([width height renderer]
@@ -102,6 +117,16 @@
     (throw (IllegalArgumentException. (str "Invalid size vector:" size ". Was expecting only 2 elements: [x-size y-size]. To specify renderer, use :renderer key."))))
   size)

+(def ^{:private true} VALID-TARGETS #{:frame :perm-frame})
+
+(defn- validate-target!
+  "Checks that the target option is one of the following allowed
+  targets: [:frame, :perm-frame]."
+  [target]
+  (when-not (some VALID-TARGETS [target])
+    (throw (IllegalArgumentException. (str "Invalid target:" target". Was expecting one of: " (vec VALID-TARGETS)))))
+  target)
+
 (defn applet
   "Create and start a new visualisation applet.

@@ -119,6 +144,8 @@
                     second where n is the target frame-rate set for
                     the visualisation.

+  :target         - one of :frame, :perm-frame. Default :frame.
+
   :focus-gained   - Called when the applet gains focus.

   :focus-lost     - Called when the applet loses focus.
@@ -147,11 +174,17 @@
   :key-typed      - Called once every time non-modifier keys are
                     pressed."
   [& opts]
-  (let [options           (merge {:size [500 300]} (apply hash-map opts))
+  (let [options           (merge {:size [500 300] :target :frame}
+                                 (apply hash-map opts))
         size              (validate-size! (:size options))
+        target            (validate-target! (:target options))
         renderer          (or (:renderer options) :p2d)
         draw-fn           (or (:draw options) (fn [] nil))
-        setup-fn          (or (:setup options) (fn [] nil))
+        setup-fn          (fn []
+                            (let [size-vec (concat size [renderer])]
+                              (apply applet-set-size size-vec))
+                            (when-let [f (:setup options)]
+                              (f)))
         key-pressed-fn    (or (:key-pressed options) (fn [] nil))
         key-released-fn   (or (:key-released options) (fn [] nil))
         key-typed-fn      (or (:key-typed options) (fn [] nil))
@@ -164,20 +197,14 @@
         mouse-clicked-fn  (or (:mouse-clicked options) (fn [] nil))
         focus-gained-fn   (or (:focus-gained options) (fn [] nil))
         focus-lost-fn     (or (:focus-lost options) (fn [] nil))
-        setup-fn          (fn []
-                            (let [size-vec (concat size [renderer])]
-                              (apply applet-set-size size-vec))
-                            (when-let [f (:setup options)]
-                              (f)))
-        frame             (atom nil)
         state             (atom nil)
-        keep-on-top?      (atom (:keep-on-top options))
-        prx               (proxy [processing.core.PApplet
+        target-obj        (atom nil)
+        prx-obj           (proxy [processing.core.PApplet
                                   clojure.lang.IMeta] []
-                            (meta [] (assoc options :frame frame
-                                            :state state))
-                            (toggleVisibility
-                              ([] (.setAlwaysOnTop this (swap! keep-on-top? false?))))
+                            (meta [] (assoc options
+                                       :state state
+                                       :target-obj target-obj
+                                       :target target))
                             (keyPressed
                               ([] (binding [*applet* this
                                             *state* state]
@@ -276,8 +303,8 @@
                               [] (binding [*applet* this
                                            *state* state]
                                    (draw-fn))))]
-    (applet-run prx renderer @keep-on-top?)
-    prx))
+    (applet-run prx-obj renderer target)
+    prx-obj))

 (defmacro defapplet
   "Define and start an applet and bind it to a var with the symbol


CMR-2468: Removed -> Removing. mapv instead of (vec (map..)


fixed typos

fixed typos

--- src/selmer/util.clj
+++ src/selmer/util.clj
@@ -32,9 +32,9 @@
 (def ^:dynamic ^Pattern   *filter-open-pattern* nil)
 (def ^:dynamic ^Pattern   *filter-close-pattern* nil)
 (def ^:dynamic ^Pattern   *filter-pattern* nil)
-(def ^:dynamic ^String    *include-pattern* nil)
-(def ^:dynamic ^String    *extends-pattern* nil)
-(def ^:dynamic ^String    *block-pattern* nil)
+(def ^:dynamic ^Pattern   *include-pattern* nil)
+(def ^:dynamic ^Pattern   *extends-pattern* nil)
+(def ^:dynamic ^Pattern   *block-pattern* nil)
 (def ^:dynamic ^Pattern   *block-super-pattern* nil)
 (def ^:dynamic ^Pattern   *endblock-pattern* nil)


Change ASTNode implementation for PersistentVector to use loop instead of doseq for a speedup.

--- src/stencil/ast.clj
+++ src/stencil/ast.clj
@@ -108,8 +108,12 @@
   (render [this ^StringBuilder sb context-stack] (.append sb this))
   clojure.lang.PersistentVector
   (render [this sb context-stack]
-    (doseq [node this]
-      (render node sb context-stack))))
+    ;; This is about 10% faster than the (much nicer) doseq equivalent.
+    (let [vec-length (long (count this))]
+      (loop [i (int 0)]
+        (when (< i vec-length)
+          (render (nth this i) sb context-stack)
+          (recur (unchecked-inc i)))))))

 ;; Implement a Zipper over ASTZippers.


Clarify console note

Clarify console note

--- src/runbld/main.clj
+++ src/runbld/main.clj
@@ -57,7 +57,7 @@
      (assert status "process did not return a status key")
      (log (format "DURATION: %sms" took))
      (log
-      (format "WRAPPER: %s (%d)" (if (zero? status)
+      (format "WRAPPED PROCESS: %s (%d)" (if (zero? status)
                                    "SUCCESS"
                                    "FAILURE") status))
      (if (and errors (pos? (count @errors)))


stupid rotation of squares

stupid rotation of squares

--- src/runner/dom.cljs
+++ src/runner/dom.cljs
@@ -85,10 +85,21 @@

 (defn square-position [squarex squarey playerx playery]
   {:left (- squarex (* physics-to-pixel playerx))
-   :bottom squarey})
+   :bottom (- squarey (* playery 0.01 squarey))})
+
+(defn square-rotation [squarex squarey playerx playery]
+  (let [rotation (* 2 (- squarex (* (/ physics-to-pixel 4) playerx)))
+        rotate (str "rotate(" rotation "deg)")
+        origin "40% 40%"]
+    {:transform rotate
+     :transform-origin origin
+     :-ms-transform rotate ;IE 9
+     :-ms-transform-origin origin ;IE 9 */
+     :-webkit-transform rotate ;Chrome, Safari, Opera
+     :-webkit-transform-origin origin}))

 (def square-width 10)
-(def square-space 100)
+(def square-space 200)
 (def horizontal-squares (js/Math.round (/ (screen-width) square-space)))
 (def vertical-squares (js/Math.round (/ (screen-height) square-space)))

@@ -96,8 +107,8 @@
 (defn square-collection
   "create data that's used for generating background squares relative to player position"
   [x y]
-    (flatten (for [squarex (range 0 (* square-width vertical-squares) square-width)]
-      (for [squarey (range 0 (* square-width horizontal-squares) square-width)]
+    (flatten (for [squarex (range 0 (* square-width horizontal-squares) square-width)]
+      (for [squarey (range 0 (* square-width vertical-squares) square-width)]
         {:x (* 20 squarex) :y (* 20 squarey)}))))

 (defn square-element [square playerx playery]
@@ -105,7 +116,8 @@
                                         :background-color "red"
                                         :width square-width
                                         :height square-width}
-                                       (square-position (:x square) (:y square) playerx playery)))} nil))
+                                       (square-position (:x square) (:y square) playerx playery)
+                                       (square-rotation (:x square) (:y square) playerx playery)))} nil))

 (defn background-view [player owner]
   (reify


utils/ifnil? to save default values to the database

--- src/trak/utils.cljs
+++ src/trak/utils.cljs
@@ -30,3 +30,6 @@
                                                      :where [?e :application/state-type ?type]]
                                                    db :path)))]
     {:handler (:handler match) :params (:params match)}))
+
+(defn ifnil? [possibly-nil default]
+  (if (nil? possibly-nil) default possibly-nil))


fix: allow string literal as constant mapping result

--- src/featured_gml/code.clj
+++ src/featured_gml/code.clj
@@ -34,10 +34,12 @@
     `[~s [[[~(keyword (hyphenated->camel (name s))) text] nil]]]))

 (defn apply-translator [translators]
-  (letfn [;f is a function and will be executed on the selection (s); example f=s/uppercase
+  (letfn [;f is a list of functions and will be executed on the selection (s); example f=s/uppercase
           (translate [[s f]] (if f
-                                  `(-> (xml1-> ~'zp ~@s) ~@f)
-                                  `(xml1-> ~'zp ~@s)))]
+                               (if (and (= 1 (count f)) (string? (first f)))
+                                 (first f)
+                                 `(-> (xml1-> ~'zp ~@s) ~@f))
+                               `(xml1-> ~'zp ~@s)))]
     (cond
       (fn? translators)
        `(~translators ~'feature)


block main thread to avoid premature termination of server (#808)

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
@@ -35,4 +35,10 @@
   (-> (parse-port port)
       (or default-port)
       (server/start)
-      (register-shutdown-hook)))
+      (register-shutdown-hook))
+
+  ;; The server (started as a daemon thread) will exit immediately
+  ;; if the main thread is allowed to terminate.  To avoid this,
+  ;; indefinitely block this thread.  Stopping the service can only
+  ;; be done externally through a SIGTERM signal.
+  @(promise))


Fix tx->html fn

Fix tx->html fn

--- src/datemo/arb.clj
+++ src/datemo/arb.clj
@@ -1,6 +1,7 @@
 (ns datemo.arb
   (:require [clojure.pprint :refer [pprint]])
-  (:use hickory.core))
+  (:use hickory.core
+        hiccup.core))

 (defn html->hiccup
   ([html] (as-hiccup (parse html)))
@@ -70,4 +71,4 @@
             (recur (conj hiccups (arb->hiccup (first items))) (next items))))))))

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


Primitive asplan works (well)

Primitive asplan works (well)

--- src/exp/asplan.clj
+++ src/exp/asplan.clj
@@ -203,9 +203,10 @@
                                      :let  [child (current-child s child-var-map nav)]
                                      :when (and child (not (env/get-var s (action-var child))))]
                                  [nav child])]
-         (println "\n" s "\n" (first (:act-seq (meta s))))
+;         (println "\n\n\n" s "\n\n" (:act-seq (meta s)) "\n")
 ;         (println "\n\n\n" s "\n"  aa-vars "\n"  aa-parent-edges "\n" na-tuples )
-        (util/cond-let [x]
+;        (util/prln
+         (util/cond-let [x]
           ;; Greedy action -- all preconditions satisfied and not assigned elsewhere
           (some #(make-greedy-fire-action s %) aa-vars)
             [x]
@@ -220,8 +221,8 @@
                 (make-add-action-action a)))

           ;; Inactive bottom-up var -- needs to be assigned.
-          (first aa-parent-edges)
-            (activation-actions s child-var-map (first x))
+          (util/find-first #(env/get-var s (free-var %)) (map first aa-parent-edges))
+            (activation-actions s child-var-map x)

           ;; Active top-down var -- add actions
           (util/find-first #(not (env/get-var s (free-var %))) (map second na-tuples))
@@ -230,7 +231,7 @@

           ;; Inactive top-down var -- activate it
           (first (map second na-tuples))
-            (activation-actions s child-var-map x))))
+            (activation-actions s child-var-map x))));)
      (env/goal-map sas-problem))))

 (defn asplan-solution-name [sol]


Reorder

Reorder

--- src/cyanite_cache/cache.clj
+++ src/cyanite_cache/cache.clj
@@ -3,12 +3,16 @@
   (:require [clojure.string :as str]
             [clojure.core.cache :as cache]))

+(defprotocol StoreCache
+  (push! [this tenant period rollup time path data ttl])
+  (flush! [this]))
+
 (def ^:const metric-wait-time 60)
 (def ^:const cache-add-ttl 180)

-(defprotocol StoreCache
-  (push! [this tenant period rollup time path data ttl])
-  (flush! [this]))
+(defn agg-avg
+  [data]
+  (/ (reduce + data) (count data)))

 (defn construct-mkey
   [tenant period rollup]
@@ -79,10 +83,6 @@
       (swap! pkeys conj path))
     exists))

-(defn agg-avg
-  [data]
-  (/ (reduce + data) (count data)))
-
 (defn simple-cache
   [fn-agg fn-store]
   (let [caches (atom {})


Add info about ascensions to web-interface, added link to american server

--- src/demogorgon/web.clj
+++ src/demogorgon/web.clj
@@ -5,7 +5,8 @@
         [ring.adapter.jetty :only (run-jetty)]
         [ring.util.codec :only (url-encode url-decode)]
         [hiccup.core :only (html escape-html)]
-        [hiccup.page-helpers :only (doctype link-to)])
+        [hiccup.page-helpers :only (doctype link-to)]
+        [demogorgon.nh :only (parse-bitfield conducts)])
   (:require [compojure.route :as route]
             [clojure.contrib.sql :as sql]))

@@ -16,7 +17,7 @@
                     :subname "/tmp/nh.db"
                     :create true})

-(defn layout [content]
+(defn layout [& content]
   (html
    (doctype :html5)
    [:html
@@ -45,7 +46,8 @@
       [:a {:href "/last-games"} "last 25 games"] " | "
       [:a {:href "/highscores"} "highscores"] " | "
       [:a {:href "/users"} "users"] " | "
-      [:a {:href "/causes"} "causes"]]
+      [:a {:href "/causes"} "causes"] " | "
+      [:a {:href "/ascensions"} "ascensions"]]
      [:br]
      content]]))

@@ -93,8 +95,18 @@
    [:td [:a {:href (str "/user/" (:name row))} (:name row)]]
    [:td (:points row)]
    [:td (:turns row)]
-   [:td (:deathdate (pretty-date row))]
+   [:td (pretty-date (:deathdate row))]
    [:td [:a {:href (str "/cause/" (url-encode (:death_uniq row)))} (:death row)]]])
+
+(defn rs-row-to-tr-ascension [row]
+  [:tr
+   [:td (make-dump-link row)]
+   [:td [:a {:href (str "/user/" (:name row))} (:name row)]]
+   [:td (:points row)]
+   [:td (:turns row)]
+   [:td (pretty-date (:deathdate row))]
+   [:td (str (count (:conducts row)) ": "
+             (apply str (interpose ", " (:conducts row))))]])

 (defn rs-to-table [rs]
   [:table
@@ -107,6 +119,34 @@
     [:th "death"]]
    (map #'rs-row-to-tr rs)])

+(defn rs-to-table-ascension [rs]
+  [:table
+   [:tr
+    [:th "game"]
+    [:th "name"]
+    [:th "points"]
+    [:th "turns"]
+    [:th "deathdate"]
+    [:th "conducts"]]
+   (map #'rs-row-to-tr-ascension rs)])
+
+(defn ascensions []
+  (sql/with-connection db
+     (let [rows
+           (map #(assoc %1 :conducts (parse-bitfield conducts (:conduct %1)))
+                (sql/with-query-results rs
+                  ["select * from xlogfile where death = 'ascended' order by points desc"]
+                  (doall rs)))
+           points-table (rs-to-table-ascension (take 10 rows))
+           conducts-table (rs-to-table-ascension
+                           (take 10
+                                 (sort-by #(* (count (:conducts %1)) -1) rows)))]
+       (layout
+        [:h2 "by points"]
+        points-table
+        [:h2 "by conducts"]
+        conducts-table))))
+
 (defn game [id]
   (sql/with-connection db
     (sql/with-query-results
@@ -153,7 +193,8 @@
         [:h2 "about"]
         [:p
          "un.nethack.nu is a public server for " [:a {:href "http://sourceforge.net/apps/trac/unnethack/"} "UnNetHack"]
-         ". It is accessible by " [:a {:href "telnet://un.nethack.nu"} "telnet"] "."]
+         ". There's a " [:a {:href "telnet://eu.un.nethack.nu"} "european server (telnet)"] " and a "
+         [:a {:href "telnet://us.un.nethack.nu"} "american server (telnet)"] "."]
         [:h2 "links"]
         [:ul
          [:li [:a {:href "/default-unnethackrc"} "default rc-file"]]
@@ -222,6 +263,7 @@
   (GET "/user/:name/" [name] (user name))
   (GET "/users" [] (users))
   (GET "/causes" [] (causes))
+  (GET "/ascensions" [] (ascensions))
   (GET "/cause/:cause-str" [cause-str] (cause cause-str))
   (GET "/highscores/:limit" [limit] (highscores limit))
   (route/not-found (page-not-found)))


more on macro

more on macro

--- src/language/macro.clj
+++ src/language/macro.clj
@@ -120,6 +120,50 @@
        ~@body
        (recur))))

+;syntax quote
+(def foo 123)
+
+(list `map `println [foo]);is the same as
+
+`(map println [~foo]);and
+
+`(map println ~[foo])
+
+(list `println (list `keyword (list `str foo)));is the same as
+
+`(println (keyword (str ~foo)))
+
+(let [defs `((def x 123)
+             (def y 456))]
+  (concat (list `do) defs))
+
+(let [defs '((def x 123)
+             (def y 456))]
+  `(do ~@defs))
+;notice that splice unquote implicitly include a concatenate operation
+;the list defs are spliced into the surrounding syntax-quoted list
+
+;a very common idiom
+
+(defmacro foo
+  [& body]
+  `(do-something
+    ~@body))
+
+(macroexpand-1
+ `(foo
+   (doseq [x [1 2 3]]
+     (* x 2))
+   :hehe))
+
+;quote again, so that the returned forms by macro won't be evaluated
+
+;macroexpand is a function, any value of it would be evaluated
+
+;quote, unquote, unquote-splicing are all functions.
+
+;we can see what these 'functions' actually do by quote them to stop the return forms evaluated
+'`(map println ~[foo])

@@ -136,6 +180,3 @@

-
-
-


Make aliases an atom so plugins can change it.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -33,9 +33,6 @@
                                   :root root#))))
      (def ~(symbol (name project-name)) project)))

-;; So it doesn't need to be fully-qualified in project.clj
-(with-ns 'clojure.core (use ['leiningen.core :only ['defproject]]))
-
 (defn abort [msg]
   (println msg)
   (System/exit 1))
@@ -49,8 +46,8 @@
         (abort "No project.clj found in this directory."))))
   ([] (read-project "project.clj")))

-(def aliases {"--help" "help" "-h" "help" "-?" "help" "-v" "version"
-              "--version" "version" "überjar" "uberjar"})
+(def aliases (atom {"--help" "help" "-h" "help" "-?" "help" "-v" "version"
+                    "--version" "version" "überjar" "uberjar"}))

 (def no-project-needed (atom #{"new" "help" "version"}))

@@ -106,7 +103,7 @@

 (defn -main
   ([& [task & args]]
-     (let [task (or (aliases task) task "help")
+     (let [task (or (@aliases task) task "help")
            args (if (@no-project-needed task)
                   args
                   (conj args (read-project)))
@@ -115,7 +112,6 @@
        (binding [*compile-path* compile-path]
          ;; TODO: can we catch only task-level arity problems here?
          ;; compare args and (:arglists (meta (resolve-task task)))?
-         ;; TODO: wrap tasks in run-task using alter-var-root
          (let [value (run-task task args)]
            (when (integer? value)
              (System/exit value))))))


Removed shutdown hook

Removed shutdown hook

--- src/elefant_server/boot.clj
+++ src/elefant_server/boot.clj
@@ -14,5 +14,4 @@
     (run-jetty-async site-and-api {:port port :join? false}))
   )
 (defn -main [& [port]]
-  (.addShutdownHook (Runtime/getRuntime) (.shutdown schejulure.core/pool))
   (start-server port))


Convert autotest into a plain function

Convert autotest into a plain function

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -365,7 +365,7 @@
 (def ^{:private true, :testable true}
   autotest-interval (atom 500))

-(defmulti autotest
+(defn autotest
   "`autotest` checks frequently for changed files. It reloads those files
   and all files that depend on them. Since test files depend on source files,
   that typically results in facts being reloaded and checked.
@@ -385,30 +385,25 @@
      (autotest :pause)  ; pause checking
      (autotest :resume) ; continue after a pause
   "
-  (fn [& args]
-    (or ((set args) :stop)
-        ((set args) :pause)
-        ((set args) :resume)
-        (pos? (count args)))))
-
-(defmethod autotest :default []
-  (autotest :each @autotest-interval))
-
-(defmethod autotest true [& args]
-  (let [options (apply hash-map args)]
-    (swap! autotest-interval #(or (:each options) %))
-    (println)
-    (project-state/load-everything)
-    (autotest :resume)))
-
-(defmethod autotest :resume [_]
-  (scheduling/schedule :autotest project-state/load-changed @autotest-interval)
-  true)
-
-(defmethod autotest :stop [_]
-  (scheduling/stop :autotest)
-  true)
-
-(defmethod autotest :pause [_]
-  (autotest :stop))
+  [& args]
+  (let [setargs (set args)]
+    (cond (or (setargs :stop)
+              (setargs :pause))
+          (scheduling/stop :autotest)
+
+          (setargs :resume)
+          (scheduling/schedule :autotest
+                               project-state/load-changed
+                               @autotest-interval)
+
+          (pos? (count args))
+          (let [options (apply hash-map args)]
+            (swap! autotest-interval #(or (:each options) %))
+            (println)
+            (project-state/load-everything)
+            (autotest :resume))
+
+          :else
+          (autotest :each @autotest-interval))))
+
 )


sawtooth change amount of beats

sawtooth change amount of beats

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -151,12 +151,15 @@

 (defn light-sawtooth
   "Change light according to sawtooth osc"
-  []
-  (def light-param (params/build-oscillated-param
-                 (oscillators/sawtooth-beat :beat-ratio 2 :down? true) :max 20))
-  (show/add-effect! :color (global-color-effect
-    (params/build-color-param :h 60 :s 100 :l light-param)))
-  )
+  ([beat-ratio]
+      (def light-param (params/build-oscillated-param
+                     (oscillators/sawtooth-beat :beat-ratio beat-ratio :down? true) :max 20))
+      (show/add-effect! :color (global-color-effect
+        (params/build-color-param :h 60 :s 100 :l light-param)))
+      )
+  ([]
+    (light-sawtooth 2))
+)

 (def main-color
   "Main color of the show"


fix body decoding for hosted scripts

fix body decoding for hosted scripts

--- src/frontend/tasks/http.clj
+++ src/frontend/tasks/http.clj
@@ -20,9 +20,9 @@
     (let [result (try
                    (doseq [script scripts]
                      (println (format "Updating %s" script))
-                     (-> @(http/get (:url script))
-                         :body
-                         (#(spit (str "resources/assets/" (:path script)) %))))
+                     (let [response @(http/get (:url script) {:as :text})]
+                       (assert (= (:status response) 200))
+                       (spit (str "resources/assets/" (:path script)) (:body response))))
                    :success
                    (catch Exception e
                      (if (> 3 tries)


Store stats in indexes too

Store stats in indexes too

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -203,9 +203,11 @@
         (let [fact (aget in-facts i)
               key (fact-ixes fact key-ixes)
               facts (or (get index key) #{})] ;; TODO transients are not seqable :(
-          (when-not (contains? facts fact)
-            (assoc!! index key (conj facts fact))
-            (apush out-facts fact))))
+          (if (not (contains? facts fact))
+            (do
+              (assoc!! index key (conj facts fact))
+              (apush out-facts fact))
+            (aset node->stats node "dupes" (+ (aget node->stats node "dupes") 1)))))
       (aset node->state node index))))

 (defn lookup-update! [index-node key-ixes val-ixes]
@@ -293,7 +295,7 @@
               (condp = (type flow)
                 Union #js {:dupes 0}
                 FilterMap nil
-                Index nil
+                Index #js {:dupes 0}
                 Lookup nil))))
     (FlowState. node->state node->out-nodes node->facts node->update! node->stats trace plan)))

@@ -319,7 +321,7 @@
               (condp = (type flow)
                 Union #js {:dupes 0}
                 FilterMap nil
-                Index nil
+                Index #js {:dupes 0}
                 Lookup nil))))
       (FlowState. node->state node->out-nodes node->facts node->update! node->stats trace plan))
     (do (println "Rebuilding state!")


last substitions

last substitions

--- src/mediakeys/core.clj
+++ src/mediakeys/core.clj
@@ -17,8 +17,8 @@

 (def incoming-sub (atom nil))
 (def incoming-observable
-    (Observable/create
-        (rx/action [^rx.Subscriber s]
+    (observable
+        (fn [s]
             (reset! incoming-sub s))))
 (def incoming-json
     (map incoming-observable
@@ -44,7 +44,7 @@
                         (.send c action))))
             (onClose [c] (println "closed" c))
             (onMessage [c j]
-                (.onNext @incoming-sub j))))
+                (next! @incoming-sub j))))
     (.add (StaticFileHandler. "."))
     (.start))
   (sub keypresses println)


upgrade to boot 2.8.3

upgrade to boot 2.8.3

--- src/migae/boot_gae.clj
+++ src/migae/boot_gae.clj
@@ -17,7 +17,7 @@
            [java.io File]
            [java.net URL URLClassLoader]))

-(def boot-version "2.7.1")
+(def boot-version "2.8.3")

 (def boot-config-edn "_boot_config.edn")
 (def webapp-edn "webapp.edn")
@@ -79,7 +79,7 @@
               appengine-config-map (-> (boot/tmp-file appengine-edn-f) slurp read-string)]
           (if servlet "target" (if (-> appengine-config-map :services)
                                  "target/default"
-                                 (str "target/" (-> appengine-config-map :module :name)))))))
+                                 (str "target/" (-> appengine-config-map :service :name)))))))

 (defn get-module-name
   [fileset servlet]
@@ -110,7 +110,7 @@
               module (if servlet "default"
                          (if (-> appengine-config-map :services)
                            "default"
-                           (-> appengine-config-map :module :name)))]
+                           (-> appengine-config-map :service :name)))]
           module)))

 (defn expand-home [s]
@@ -120,6 +120,7 @@

 (def sdk-string (let [jars (pod/resolve-dependency-jars (boot/get-env) true)
                       zip (filter #(.startsWith (.getName %) "appengine-java-sdk") jars)]
+                  ;; (println jars)
                   (if (empty? zip)
                     (println "appengine-java-sdk zipfile not found")
                     (let [fname (first (for [f zip] (.getName f)))
@@ -394,15 +395,15 @@
                                          appengine-edn))))))

              appengine-config-map (assoc-in appengine-config-map
-                                            [:module :name] module)
+                                            [:service :name] module)

              app-id (:app-id appengine-config-map)

-             version (-> appengine-config-map :module :version)
+             version (-> appengine-config-map :service :version)
              _ (if version
                  (if (not= version  (.toLowerCase version))
                    (throw (Exception. (str "Upper-case not allowed in GAE version string: " version))))
-                 (throw (Exception. ":module :version string required in " appengine-edn)))
+                 (throw (Exception. ":service :version string required in " appengine-edn)))

              appengine-config-map (assoc
                                    (-> appengine-config-map
@@ -637,12 +638,14 @@
   [d dir DIR str "output dir"
    c config-syms SYMS #{sym} "namespaced symbols bound to meta-config data"
    k keep bool "keep intermediate .clj files"
-   u unit-test bool "configure for unit testing (module = 'default')"
+   u unit-test bool "configure for unit testing (service = 'default')"
    v verbose bool "Print trace messages."]
   (comp
    (webxml :verbose verbose)
    (appengine :unit-test unit-test :verbose verbose)))

+;; FIXME: EAR support is deprecated for Java 8 and up. Remove
+;; META-INF, appengine-application.xml and application.xml
 (boot/deftask config-app
   "generate xml config files for microservices app"
   [d dir DIR str "output dir"
@@ -934,10 +937,14 @@
   ;;NB: java property expected by kickstart is "appengine.sdk.root"
   ;; (print-task "install-sdk" *opts*)
   (let [release (or release "RELEASE")
-        coords (vector 'com.google.appengine/appengine-java-sdk
-                       "RELEASE"
-                       :extension "zip")
-        jar-path (pod/resolve-dependency-jar (boot/get-env) coords)
+        sdk-coord (first
+                   (filter #(= (first %) 'com.google.appengine/appengine-java-sdk) (:dependencies (boot/get-env))))
+        sdk-version (second sdk-coord)
+        _ (println (str "installing sdk version: " sdk-version))
+        ;; coord (vector 'com.google.appengine/appengine-java-sdk
+        ;;               sdk-version
+        ;;               :extension "zip")
+        jar-path (pod/resolve-dependency-jar (boot/get-env) sdk-coord)
         sdk-dir (io/as-file (:sdk-root config-map))
         prev        (atom nil)]
     (boot/with-pre-wrap fileset
@@ -1001,8 +1008,8 @@
                   coords (:coords co)
                   pod-env (update-in (dissoc (boot/get-env) :checkouts)
                                      [:dependencies] #(identity %2)
-                                     (concat '[[boot/core "2.7.1"] ;; ~(str boot-version)]
-                                               [boot/pod "2.7.1"]] ;; ~(str boot-version)]]
+                                     (concat '[[boot/core "2.8.3"] ;; ~(str boot-version)]
+                                               [boot/pod "2.8.3"]] ;; ~(str boot-version)]]
                                              (vector coords)))
                   pod (future (pod/make-pod pod-env))]
               (if verbose (println "MODULE: " mod))
@@ -1210,7 +1217,7 @@

                             appengine-config-edn-map
                             (-> (boot/tmp-file boot-config-edn-f) slurp read-string)]
-                        (-> appengine-config-edn-map :module :name)))
+                        (-> appengine-config-edn-map :service :name)))

              ]

@@ -1239,7 +1246,7 @@

              (let [reloader-impl-content (stencil/render-file "migae/boot_gae/reloader-impl.mustache"
                                                               {:reloader-ns reloader-impl-ns
-                                                               :module module})
+                                                               :service module})

                    gen-reloader-content (stencil/render-file "migae/boot_gae/gen-reloader.mustache"
                                                              {:gen-reloader-ns gen-reloader-ns
@@ -1428,7 +1435,7 @@
    _ jacoco-agent-args VAL str"--jacoco_agent_args"
    _ jacoco-exec VAL str "--jacoco_exec"

-   _ services SERVICES edn "services map, keys :service, :port"
+   _ services SERVICES edn "services map, keys :service, :wardir, :port"

    s servlet bool "servlet app DEPRECATED"
    v verbose bool "verbose"]
@@ -1443,11 +1450,11 @@
           #_(if servlet "target"
                                     (if (-> appengine-config-map :services)
                                       "target/default"
-                                      (str "target/" (-> appengine-config-map :module :name))))
+                                      (str "target/" (-> appengine-config-map :service :name))))

           checkout-vec (-> (boot/get-env) :checkouts)
           cos (map #(assoc (apply hash-map %) :coords [(first %) (second %)]) checkout-vec)
-          default-mod (filter #(or (:default %) (not (:module %))) cos)
+          default-mod (filter #(or (:default %) (not (:service %))) cos)
           _ (if (> (count default-mod) 1)
               (throw (Exception. "Only one default module allowed" (count default-mod))))


Composing transducers for async/chan

Composing transducers for async/chan

--- 2017/reducers-transducers-async/clojure/reducers/src/reducers/async_transducer_comp.clj
+++ 2017/reducers-transducers-async/clojure/reducers/src/reducers/async_transducer_comp.clj
@@ -2,7 +2,7 @@
 ;;;
 ;;; Eli Bendersky [http://eli.thegreenplace.net]
 ;;; This code is in the public domain.
-(ns reducers.async-transducer
+(ns reducers.async-transducer-comp
   (:require [clojure.core.async :as async]))

 (defn square [x] (* x x))
@@ -14,3 +14,11 @@
     (map square)
     (map inc)))

+(def c (async/chan 1 xform))
+
+(async/go
+  (async/onto-chan c [5 6 8 12 15]))
+(loop [n (async/<!! c)]
+  (when n
+    (println n)
+    (recur (async/<!! c))))


improve crowbar puzzle

improve crowbar puzzle

--- src/house/rooms/garden.cljc
+++ src/house/rooms/garden.cljc
@@ -29,18 +29,19 @@
                             :open true
                             :enter :back-hall3)
         new-map (room/connect (:room-map gs) :house-back :south :back-hall3)]
-    (-> gs
-      (assoc :room-map new-map)
-      (utils/replace-item door new-door))))
+    (if-not (:locked door)
+      (-> gs
+        (assoc :room-map new-map)
+        (utils/replace-item door new-door)))))

-; FIXME need to cover case use with screw and use with hammer, screwdriver
-; FIXME unlock with crowbar is sort of funny, but open with isn't, it should work! --> probably best to separate verbs
 (def back-door (item/make ["door" "back door"]
                           "It didn't look particularly tough."
                           :break "Perhaps with the proper tooling."
                           :enter "It was locked."
                           :unlock {:say "Sure. I unlocked the hell out of it. The door was now open."
-                                   :post `crow-post} ; FIXME so far not working
+                                   :post `crow-post}
+                          :open-with {:say "Easy job for the crowbar. The door was now open."
+                                      :post `crow-post}
                           :locked true))

 (def crowbar (item/make "crowbar" "satisfy all your breaking-into-places needs."


adding etc support for configuration file

--- src/celestial/common.clj
+++ src/celestial/common.clj
@@ -6,15 +6,15 @@
     [taoensso.timbre :only (warn)]
     [clj-config.core :as conf]))

-(def path (<< "~(System/getProperty \"user.home\")/.celestial.edn"))
-
-(defn config-exists? [] (.exists (file path)))
+(def path
+  (first (filter #(.exists (file %))
+    ["/etc/celestial.edn" (<< "~(System/getProperty \"user.home\")/.celestial.edn")])))

 (def config
-   (if (config-exists?)
+   (if path
       (conf/read-config path)
       (do
-        (warn (<< "~{path} does not exist, make sure to configure it"))
+        (warn (<< "~{path} does not exist, make sure to configure it using default configuration"))
         {:celestial
           {:log {:level :trace :path "celestial.log" :gelf-host ""} }}
         )


add drop! fn back to seed

add drop! fn back to seed

--- src/chat/server/seed.clj
+++ src/chat/server/seed.clj
@@ -1,6 +1,12 @@
 (ns chat.server.seed
   (:require [chat.server.db :as db]
-            [environ.core :refer [env]]))
+            [environ.core :refer [env]]
+            [datomic.api :as d]
+            [braid.server.conf :as conf]))
+
+(defn drop! []
+  (let [db-url (get conf/config :db-url "datomic:free://localhost:4334/braid")]
+    (d/delete-database db-url)))

 (defn seed! []
   (let [group-1 (db/create-group! {:id (db/uuid) :name "Braid"})


note about compiled-cljs cache

note about compiled-cljs cache

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -340,6 +340,7 @@
 (defn output-directory [opts]
   (or (:output-dir opts) "out"))

+;; cache from js file path to map of {:file .. :provides .. :requires ..}
 (def compiled-cljs (atom {}))

 (defn compiled-file


Fix access to an old BAM index

Fix access to an old BAM index

--- src/cljam/bam/reader.clj
+++ src/cljam/bam/reader.clj
@@ -172,9 +172,9 @@
 (defn read-blocks*
   [^BAMReader rdr
    ^String chr ^Long start ^Long end]
-  (when (nil? (.index rdr))
+  (when (nil? @(.index-delay rdr))
     (throw (Exception. "BAM index not found")))
-  (let [^BAMIndex bai (.index rdr)
+  (let [^BAMIndex bai @(.index-delay rdr)
         spans (get-spans bai (ref-id (.refs rdr) chr) start end)
         window (fn [^clojure.lang.PersistentHashMap a]
                  (let [^Long left (:pos a)]


Basic package contents are displayed during generation

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/dar/write.clj
+++ src/obcc/dar/write.clj
@@ -77,6 +77,7 @@
 ;;--------------------------------------------------------------------------------------
 (defn buildentry [{:keys [path handle]}]
   (let [[sha size payload] (import handle)]
+    (printf "%d\t\t%s\t%s\n" size sha path)
     (fl/protobuf Entries :path path :size size :sha1 sha :data payload)))

 ;;--------------------------------------------------------------------------------------
@@ -88,7 +89,12 @@
 (defn buildentries [files]
   (map buildentry files))

+(def div (apply str (repeat 120 "-")))
+
 (defn write [rootpath filespec outputfile]
+  (println div)
+  (println "Size\t\tSHA1\t\t\t\t\t\tPath")
+  (println div)
   (let [files (buildfiles rootpath filespec)
         header (fl/protobuf Header :magic "com.obc.deterministic-archive" :version 1)
         entries (buildentries files)
@@ -101,4 +107,6 @@

     ;; emit our output
     (with-open [os (io/output-stream outputfile :truncate true)]
-      (fl/protobuf-write os header archive))))
+      (fl/protobuf-write os header archive)))
+
+  (println div))


added a separate continue?-fn hook fn as argument to the parser

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -53,21 +53,20 @@
  { :parents [ {:type <[ or ( or { or \" or \\> :line :offset :col} ... ]
    :offset current-offset :line current-line :col current-col}"

-#_(defn default-parser-hook
-  ; todo : later on, move offset+line+col+parents inside a proper deftyped type
-  [#^String text offset line col parents hook-state]
-  [(< offset (.length text))
-   { :parents parents :offset offset :line line :col col }])
+; todo : later on, move offset+line+col+parents inside a proper deftyped type
+(defn default-accumulator
+  [#^String text offset line col parents parser-state accumulated-state]
+    [#^String text offset line col parents parser-state accumulated-state]
+    nil)

-(defn make-stop-offset-based-parser-hook
+(defn make-default-continue?-fn
   [stop-offset]
-  (fn stop-offset-based-parser-hook
-  ; todo : later on, move offset+line+col+parents inside a proper deftyped type
-    [#^String text offset line col parents parser-state hook-state]
-    [(< offset stop-offset) nil]))
+  (fn default-continue?-fn
+    [#^String text offset line col parents parser-state accumulated-state]
+    (< offset stop-offset)))

-(defn default-parser-result-maker
-  [#^String text offset line col parents parser-state hook-state]
+(defn default-make-result
+  [#^String text offset line col parents parser-state accumulated-state]
   { :parents parents :offset offset :line line :col col })

 (defn parse
@@ -75,37 +74,38 @@
 	 TODO: make the parser restartable at a given offset given a state ...
 	 TODO: make the parser fully incremental (via chunks of any possible size ...)"
   ([#^String text] (parse text (.length text)))
-  ([#^String text stop-offset] (parse text nil (make-stop-offset-based-parser-hook stop-offset) default-parser-result-maker))
-	([#^String text initial-hook-state parser-hook parser-result-maker]
+  ([#^String text stop-offset] (parse text nil default-accumulator (make-default-continue?-fn stop-offset) default-make-result))
+	([#^String text initial-accumulated-state accumulator-fn continue?-fn make-result-fn]
 	  (loop [offset  (int 0)
 	         line    (int 0)
 	         col     (int 0)
 	         parents [{:type nil :offset 0 :line 0 :col 0}]
-	         hook-state initial-hook-state]
+	         accumulated-state initial-accumulated-state]
 	      (let [parser-state (if (>= offset (.length text)) :eof :ok) ; TODO soon an additional :parser-error state !
-	            [continue? hook-state] (parser-hook text offset line col parents parser-state hook-state)]
+	            accumulated-state (accumulator-fn text offset line col parents parser-state accumulated-state)
+	            continue? (continue?-fn text offset line col parents parser-state accumulated-state)]
   	      (if (or (not continue?) (= :eof parser-state))
-  	        (parser-result-maker text offset line col parents parser-state hook-state)
+  	        (make-result-fn text offset line col parents parser-state accumulated-state)
   	        (let [c (.charAt text offset)] ; c: current char
   	          (condp = (-> parents peek :type)
   	            \"
                   (cond
                     (= \newline c)
-                      (recur (inc offset) (inc line) (int 0) parents hook-state)
+                      (recur (inc offset) (inc line) (int 0) parents accumulated-state)
                     (= \" c)
                       (if (= offset 0)
-                        (recur (inc offset) line (inc col) (conj parents {:type c :line line :col col :offset offset}) hook-state)
+                        (recur (inc offset) line (inc col) (conj parents {:type c :line line :col col :offset offset}) accumulated-state)
                         (if (= \\ (.charAt text (dec offset)))
-                          (recur (inc offset) line (inc col) parents hook-state)
-                          (recur (inc offset) line (inc col) (pop parents) hook-state)))
+                          (recur (inc offset) line (inc col) parents accumulated-state)
+                          (recur (inc offset) line (inc col) (pop parents) accumulated-state)))
                     :else
-                      (recur (inc offset) line (inc col) parents hook-state))
+                      (recur (inc offset) line (inc col) parents accumulated-state))
                 \;
                   (cond
                     (= \newline c)
-                      (recur (inc offset) (inc line) (int 0) (pop parents) hook-state)
+                      (recur (inc offset) (inc line) (int 0) (pop parents) accumulated-state)
                     :else
-                      (recur (inc offset) line (inc col) parents hook-state))
+                      (recur (inc offset) line (inc col) parents accumulated-state))
                 \\
                   (cond   ; leaved as a template if new cases have to be handled
                     #_(*opening-brackets* c)
@@ -117,60 +117,60 @@
                     ; TODO refactor the following stuff. or keep for performance ? (bleh)
                     (start-like (.substring text (-> parents peek :offset)) "\\newline")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\newline"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     (start-like (.substring text (-> parents peek :offset)) "\\tab")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\tab"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     (start-like (.substring text (-> parents peek :offset)) "\\space")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\space"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     (start-like (.substring text (-> parents peek :offset)) "\\backspace")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\backspace"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     (start-like (.substring text (-> parents peek :offset)) "\\formfeed")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\formfeed"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     (start-like (.substring text (-> parents peek :offset)) "\\return")
                       (if (< (inc (- offset (-> parents peek :offset))) (.length "\\return"))
-                        (recur (inc offset) line (inc col) parents hook-state)
-                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                        (recur (inc offset) line (inc col) parents accumulated-state)
+                        (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                     ; TODO I don't like the fact the next two conditions on \r and \newline are repeated from the default case
                     ;      clearly a level of indirection is missing regarding the update of line, offset and col
                     (= (first "\r") c)
-                      (recur (inc offset) line col parents hook-state) ; we do not increment the column
+                      (recur (inc offset) line col parents accumulated-state) ; we do not increment the column
                     (= \newline c)
-                      (recur (inc offset) (inc line) (int 0) parents hook-state)
+                      (recur (inc offset) (inc line) (int 0) parents accumulated-state)
                     :else
-                      (recur (inc offset) line (inc col) (pop parents) hook-state))
+                      (recur (inc offset) line (inc col) (pop parents) accumulated-state))
                 ; last falling case: we are in plain code, neither in a string, regexp or a comment
                 (cond
                   (*opening-brackets* c)
                     (recur
                       (inc offset) line (inc col)
                       (conj parents {:type c :offset offset :line line :col col})
-                       hook-state)
+                       accumulated-state)
                   (*closing-brackets* c)
                     (recur
                       (inc offset) line (inc col)
                       (pop parents)
-                       hook-state)
+                       accumulated-state)
                   (= (first "\r") c)
-                    (recur (inc offset) line col parents hook-state) ; we do not increment the column
+                    (recur (inc offset) line col parents accumulated-state) ; we do not increment the column
                   (= \newline c)
-                    (recur (inc offset) (inc line) (int 0) parents hook-state)
+                    (recur (inc offset) (inc line) (int 0) parents accumulated-state)
                   (= \" c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col }) hook-state)
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col }) accumulated-state)
                   (= \; c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) hook-state)
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) accumulated-state)
                   (= \\ c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) hook-state)
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) accumulated-state)
                   :else
-                    (recur (inc offset) line (inc col) parents hook-state))
+                    (recur (inc offset) line (inc col) parents accumulated-state))

                   #_(cond   ; leaved as a template if new cases have to be handled
                     (*opening-brackets* c)
@@ -181,7 +181,7 @@
                     (= \; c)
                     (= \\ c)
                     :else
-                      (recur (inc offset) line (inc col) parents hook-state)))))))))
+                      (recur (inc offset) line (inc col) parents accumulated-state)))))))))

 (comment
 (defn parse-lib


fixed indentation

fixed indentation

--- Programs/02-99-Bottles-of-Beer/solutions/askl56-bottles-of-beer.clj
+++ Programs/02-99-Bottles-of-Beer/solutions/askl56-bottles-of-beer.clj
@@ -2,11 +2,11 @@
   [start]
   (doseq [n (range start 0 -1)]
     (printf "%d bottles of beer on the wall,
-%d bottles of beer,
-Take one down, pass it around,
-%d bottles of beer on the wall.\n\n"
-          n
-          n
-          (dec n))))
+      %d bottles of beer,
+      Take one down, pass it around,
+      %d bottles of beer on the wall.\n\n"
+      n
+      n
+      (dec n))))

 (sing 99)


Allow pronoun.is/she/or/xe syntax

Allow pronoun.is/she/or/xe syntax

--- src/pronouns/pages.clj
+++ src/pronouns/pages.clj
@@ -191,7 +191,7 @@
 (defn pronouns [params]
   (let [path (params :*)
         alts (or (params "or") [])
-        pronouns (concat [path] (u/vec-coerce alts))
+        pronouns (concat (s/split path #"/or/") (u/vec-coerce alts))
         pronoun-declensions (filter some? (map #(lookup-pronouns
                                                  (escape-html %))
                                                pronouns))]