clean up docs

clean up docs

--- sidecar/src/figwheel_sidecar/config_check/validate_config.clj
+++ sidecar/src/figwheel_sidecar/config_check/validate_config.clj
@@ -145,7 +145,7 @@
    )))

-#_(get-docs)
+

 (def shared-type-rules
   (distinct
@@ -155,109 +155,11 @@
     (spec 'Integer (fn [x] (integer? x)))
     (or-spec 'BoolOrString string? (ref-schema 'Boolean))
     (or-spec 'SymbolOrString string? symbol?)
-    (or-spec 'Named string? symbol? keyword?)
-    (get-docs
-    ['CompilerOptions
-     'FigwheelOptions
-     'FigwheelClientOptions
-     'BuildOptionsMap
-     'CljsbuildOptions
-     'RootMap
-     'ReloadCljFiles]))))
+    (or-spec 'Named string? symbol? keyword?))))

 #_(spec 'RootMap
           {:figwheel  (ref-schema 'FigwheelOptions)
            :cljsbuild (ref-schema 'CljsbuildOptions)})
-
-(def figwheel-docs
-  (distinct
-   (concat
-
-    #_(doc 'RootMap "Top level configuration map. Most often top level keys in project.clj"
-         {:figwheel "A map of options for the Figwheel system and server."
-          :cljsbuild {:content (str "A map of lein-cljsbuild options. Figwheel also uses the\n"
-                                    "ClojureScript build configurations found in the cljsbuild\n"
-                                    "options.")
-                      :example {:builds [{:id "dev"
-                                          :source-paths ["src"]
-                                          :figwheel true
-                                          :compiler {:main 'example.core
-                                                     :output-dir "resources/public/compiled"
-                                                     :output-to  "resources/public/compiled/example.js"
-                                                     :source-maps true
-                                                     :source-map-timestamp true
-                                                     :recompile-dependents false}}]}}})
-
-    #_(doc 'FigwheelOptions "Figwheel Server and System Options"
-         {:http-server-root (str "A string that specifies a sub directory on your resource path. "
-                                 "This is the path to the static resources that will be served by the figwheel server. "
-                                 "This defaults to 'public' and should never be blank.")
-          :server-port (str "An integer that the figwheel server should bind.  This defaults to 3449")
-          :server-ip   (str "The network interface that the figwheel server will listen on.  This defaults to 'localhost'.")
-          :css-dirs {:content (str "A vector of paths from the project root to the location of your css files. "
-                                   "These files will be watched for changes and the figwheel client will attempt to reload them.")
-                     :example ["resources/public/css"]}
-          :reload-clj-files (str "Either false or a Map like {:cljc false :clj true}. "
-                                 "False will disable the reloading of clj files when they change. "
-                                 "You can also declare that you want to exclude .cljc or .clj files "
-                                 "from the auto reloading. Default: true")
-          :open-file-command (str "A path to an executable shell script that will be passed a file and line information "
-                                  "for a particualr compilation error or warning.")
-          :ring-handler (str "If you want to embed a ring handler into the figwheel http-kit server; "
-                             "this is for simple ring servers, if this doesn't work for you just run your own server. Default: Off")
-          :repl (str "A Boolean value indicated wether to run a ClojureScript "
-                     "REPL after the figwheel process has launched. Default: true")
-          :nrepl-port (str "An integer indicating that you would like figwheel to "
-                           "lauch nREPL from within the figwheel process and what "
-                           "port you would like it to launch on. Default: off")
-          :nrepl-middleware (str "A vector of strings indicating the nREPL middleware you want included when nREPL launches.")
-          :validate-config (str "Set this to false to skip the configuration validation. This can "
-                                "speed up your figwheel start time."
-                                "Default: true")})
-
-    #_(doc 'ReloadCljFiles "A map indicating which type of clj files should be reloaded on change."
-         {:clj (str "A boolean indicating whether you want changes to clj files to trigger a "
-                    "reloading of the clj file and the dependent cljs files.")
-          :cljc (str "A boolean indicating whether you want changes to cljc files to trigger a "
-                     "reloading of the clj file and the dependent cljs files.")})
-
-    #_(doc 'CljsbuildOptions "A map of options used by lein-cljsbuild and lein-figwheel"
-         {:builds (str "The :builds option should be set to either a sequence of build config maps or a map of build configs. "
-                       "Each map will be treated as a separate, independent, ClojureScript compiler configuration.")
-          :repl-listen-port (str "When using a ClojureScript REPL, this option controls what port "
-                                 "it listens on for a browser to connect to.  Defaults to 9000.")
-          :repl-launch-commands (str "The keys in this map identify repl-launch commands.  The values are "
-                                     "sequences representing shell commands like [command, arg1, arg2, ...]. "
-                                     "Defaults to the empty map")
-          :test-commands (str "The keys in this map identify test commands.  The values are sequences "
-                              "representing shell commands like [command, arg1, arg2, ...].  Note that "
-                              "the :stdout and :stderr options work here as well. Defaults to the empty map.")
-          :crossovers (str "Super deprecated. You should not be using :crossovers. Please use .cljc functionality.")
-          :crossover-path (str "Super deprecated. You should not be using :crossovers. Please use .cljc functionality.")
-          :crossover-jar (str "Super deprecated. You should not be using :crossovers. Please use .cljc functionality.") })
-
-    #_(doc 'BuildOptionsMap "A map of options that specifies a ClojrueScript 'build'"
-         {:id "A Keyword, String or Symbol that identifies this build."
-          :source-paths  (str "A vector of paths to your cljs source files. These paths should be relative from the"
-                              "root of the project to the root the namespace. "
-                              "For example, if you have an src/example/core.cljs file that contains a "
-                              "example.core namespace, the source path to this file is \"src\"")
-
-          :notify-command (str "If a :notify-command is specified, it will be called when compilation succeeds"
-                               "or fails, and a textual description of what happened will be appended as the "
-                               "last argument to the command.  If a more complex command needs to be constructed, "
-                               "the recommendation is to write a small shell script wrapper. "
-                               "Default: nil (disabled).")})
-    #_(doc 'FigwheelClientOptions "A map of options that will be passed to the figwheel client."
-         {:websocket-host (str "A String specifying the host part of the Figwheel websocket URL. This defaults to "
-                               "\"localhost\".  If you have JavaScript clients that need to access Figwheel "
-                               "that are not local you can supply the IP address of your machine "
-                               "here. You can also specify :js-client-host and the "
-                               "Figwheel client will use the js/location.host of the client.")
-
-          })
-
-    )))

 (def figwheel-cljsbuild-rules
   (distinct
@@ -326,7 +228,14 @@
               :devcards            (ref-schema 'Boolean)
               :eval-fn             (ref-schema 'Named)})
     (or-spec 'WebsocketHost :js-client-host string?)
-    figwheel-docs)))
+    (get-docs
+    ['CompilerOptions
+     'FigwheelOptions
+     'FigwheelClientOptions
+     'BuildOptionsMap
+     'CljsbuildOptions
+     'RootMap
+     'ReloadCljFiles]))))

 (def schema-rules-base
   (concat


Make tests pass

Make tests pass

--- src/atom_finder/atom_patch.clj
+++ src/atom_finder/atom_patch.clj
@@ -143,9 +143,9 @@
        ))

 (s/defn parse-commit-for-atom
-  :- [(s/one s/Str "commit-hash")
-      (s/one {s/Str {s/Keyword s/Bool}} "files")
-      (s/one #{s/Int} "bugs")]
+  ;:- [(s/one s/Str "commit-hash")
+  ;    (s/one {s/Str {s/Keyword s/Bool}} "files")
+  ;    (s/optional #{[(s/one s/Str "name") (s/one s/Int "id")]} "bugs")]
   [repo atoms rev-commit]
   (let [commit-hash (.name rev-commit)]
     (try
@@ -166,27 +166,12 @@

 ;(atoms-removed-in-commit repo "5a59a1ad725b5e332521d0abd7f2f52ec9bb386d" conditional-atom?)

-(defn log-atom-removed-all-commits
-  []
-  (binding [*out* (clojure.java.io/writer "gcc-logic-as-control-flow-commits.txt")]
-    (->> ;conditional-atom?
-         logic-as-control-flow-atom?
-         (atom-removed-all-commits gcc-repo)
-         ;(atom-removed-all-commits ag-repo)
-         ;(atom-removed-all-commits (gitp/load-repo "/Volumes/RAM Disk/gcc"))
-         ;(filter #(true? (nth % 1)))
-         ;(take 3)
-         (map println)
-         (take 100)
-         dorun
-         time)))
-
 (defn log-atoms-removed-all-commits
   [repo]
   (binding [*out* (clojure.java.io/writer "gcc-logic-as-control-flow-commits.txt")]
-    (->> logic-as-control-flow-atom?
-         (atom-removed-all-commits repo)
-         (map println)
-         (take 100)
+    (->> atoms
+         (atoms-removed-all-commits repo)
+         (map prn)
+         (take 10)
          dorun
          time)))


s/if-then/default/

s/if-then/default/

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2508,7 +2508,7 @@
       ;; <noun default rules>

       ;; make :propernoun and :pronoun available to morphological rules
-      ;; to prevent e.g. (they -> theys) or (ourselves -> ourselvess)
+      ;; to prevent e.g. (they -> *theys) or (ourselves -> *ourselvess)
       (default
        (let [pronoun (atom :top)
                         propernoun (atom :top)]
@@ -2601,11 +2601,10 @@
                                 :sem {:obj obj}}}}}))

       ;; add :sem :obj if necessary, so that intransitivize is triggered.
-      (if-then {:modal-with false
+      (default {:modal-with false
                 :synsem {:cat :verb
-                         :subcat {:2 {:cat :noun}}}}
-               {:synsem {:sem {:obj {:pred :top}}}})
-
+                         :subcat {:2 {:cat :noun}}
+                         :sem {:obj {:pred :top}}}})

       (new-entries ;; remove the second argument and semantic object to make verbs intransitive.
        {:synsem {:cat :verb


refine "at"

refine "at"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -99,9 +99,12 @@
    "assure" {:synsem {:cat :verb
                       :sem {:pred :assure}}}

-   "at" (let [obj (atom {:location true})]
+   "at" (let [obj (atom {:location true
+                         :reflexive false})]
           {:synsem {:cat :prep
-                    :subcat {:1 {:sem obj}}
+                    :subcat {:1 {:cat :noun
+                                 :subcat '()
+                                 :sem obj}}
                     :sem {:obj obj
                           :pred :at}}})


remove redundant "we" entries

remove redundant "we" entries

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2171,28 +2171,6 @@
                    :gender :masc
                    :pred :noi}
              :subcat '()}}]
-
-   "we (♂)" {:synsem {:cat :noun
-                      :pronoun true
-                      :case :nom
-                      :agr {:person :1st
-                            :gender :masc
-                            :number :plur}
-                      :sem {:human true
-                            :gender :masc
-                            :pred :noi}
-                      :subcat '()}}
-
-   "we (♀)" {:synsem {:cat :noun
-                      :pronoun true
-                      :case :nom
-                      :agr {:person :1st
-                            :gender :masc
-                            :number :plur}
-                      :sem {:human true
-                            :gender :fem
-                            :pred :noi}
-                      :subcat '()}}

    "wear"  {:english {:past "wore"}
             :synsem {:cat :verb


add gender distinctions for je,tu, and vous

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -208,7 +208,6 @@

    "essayer" {:synsem {:cat :verb
                       :sem {:pred :try}}}
-
    "être"
    (let [common
          {:synsem {:cat :verb
@@ -317,14 +316,21 @@
 ;;  "interessér" {:synsem {:cat :verb
 ;;                         :sem {:pred :interest??}}}

-  "je" {:synsem {:cat :noun
-                 :pronoun true
-                 :case :nom
-                 :agr {:person :1st
-                       :number :sing}
-                 :sem {:human true
-                       :pred :I}
-                 :subcat '()}}
+  "je"
+  (let [common {:synsem {:cat :noun
+                         :pronoun true
+                         :case :nom
+                         :agr {:person :1st
+                               :number :sing}
+                         :sem {:human true
+                               :pred :I}
+                         :subcat '()}}]
+    [(unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :fem}}})
+     (unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :masc}}})])

   "laisser" {:synsem {:cat :verb
                       :sem {:pred :leave-behind}}}
@@ -422,23 +428,29 @@
   "touer" {:synsem {:cat :verb
                     :sem {:pred :kill}}}
   "tu"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :nom
-             :agr {:person :2nd
-                   :number :sing}
-              :sem {:human true
-                    :pred :tu}
-             :subcat '()}}
-   "vous"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :nom
-             :agr {:person :2nd
-                   :number :plur}
-              :sem {:human true
-                    :pred :voi}
-             :subcat '()}}
+  (let [common {:synsem {:cat :nom
+                         :agr {:person :2nd
+                               :number :sing}
+                         :sem {:human true
+                               :pred :tu}}}]
+    [(unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :fem}}})
+     (unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :masc}}})])
+    "vous"
+   (let [common {:synsem {:case :nom
+                         :agr {:person :2nd
+                               :number :plur}
+                         :sem {:human true
+                               :pred :voi}}}]
+    [(unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :fem}}})
+     (unify gender-pronoun-agreement
+            common
+            {:synsem {:agr {:gender :masc}}})])
    })

 (def lexicon


Fix copy and paste error.

Fix copy and paste error.

--- src/afterglow/controllers/launchpad_mk2.clj
+++ src/afterglow/controllers/launchpad_mk2.clj
@@ -683,7 +683,7 @@
                :overlays             (controllers/create-overlay-state)
                :move-listeners       (atom #{})
                :grid-controller-impl (atom nil)}
-              {:type :launchpad-pro})]
+              {:type :launchpad-mk2})]
         (reset! (:midi-handler controller) (partial midi-received controller))
         (reset! (:grid-controller-impl controller)
                 (reify controllers/IGridController


cleanup cleanup-domains code. doesn't need to look at remote version

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -87,9 +87,7 @@
         local-dir (:local-dir local-config)]
     (doseq [domain (keys domains-info)]
       (let [local-domain-root (str (path local-dir domain))
-            remote-path (-> global-config :domains (get domain))
-            remote-vs (DomainStore. fs remote-path)
-            local-vs (DomainStore. lfs local-domain-root (.getSpec remote-vs))]
+            local-vs (DomainStore. lfs local-domain-root)]
         (log-message "Cleaning up local domain versions (only keeping latest version) for domain: " domain)
         (.cleanup local-vs 1)))))


minor whitespace

minor whitespace

--- src/cljs/greffe/doc_comps.cljs
+++ src/cljs/greffe/doc_comps.cljs
@@ -145,8 +145,7 @@
                                   (let [msg (<! listening)]
                                     (when-not (= uuid (:uuid msg))
                                       (om/set-state! owner :editText false))
-                                    (recur)))
-                               ))
+                                    (recur)))))
                              (om/set-state!
                                owner
                                :editText


Updated rest to next in source, except where it doesn't matter

--- src/compojure/http/servlet.clj
+++ src/compojure/http/servlet.clj
@@ -36,7 +36,7 @@
   "Parse key/value strings to make them more Clojure-friendly."
   [key val]
   [(keyword key)
-   (if (rest val) val (first val))])
+   (if (next val) val (first val))])

 (defn get-params
   "Creates a name/value map of all the request parameters."


Refactored cookie sessions to use seal/unseal

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -73,32 +73,6 @@
       dissoc (session :id))))

 ;; Cookie sessions
-(def *default-encryption*
-  {:algorithm      "AES/CBC/PKCS5Padding"
-   :secret-key     (gen-key "AES" 128)
-   :cbc-params     (gen-iv-param 16)
-   :hash-key       (secure-random-bytes 32)
-   :hash-algorithm "HmacSHA256"})
-
-(defn session-hmac
-  "Calculate a HMAC for a marshalled session.  Uses the :hash-key and
-   :hash-algorithm of the :encryption repository map."
-  [repository cookie-data]
-  (let [encryption-opts (merge *default-encryption*
-                              (:encryption repository))
-        hash-key        (:hash-key encryption-opts)
-        hash-algorithm  (:hash-algorithm encryption-opts)]
-    (hmac hash-key hash-algorithm cookie-data)))
-
-(defn session-crypt
-  "Encrypt or decrypt session data."
-  [repository func session]
-  (let [encryption-opts (merge *default-encryption*
-                               (:encryption repository))
-        key             (:secret-key encryption-opts)
-        algorithm       (:algorithm encryption-opts)
-        params          (:cbc-params encryption-opts)]
-    (func key algorithm params session)))

 (defmethod create-session :cookie
   [repository]
@@ -106,16 +80,14 @@

 (defmethod session-cookie :cookie
   [repository new? session]
-  (let [cookie-data (session-crypt repository encrypt (marshal session))]
+  (let [cookie-data (seal session)]
     (if (> (count cookie-data) 4000)
       (throwf "Session data exceeds 4K")
-      (str cookie-data "--" (session-hmac repository cookie-data)))))
+      cookie-data)))

 (defmethod read-session :cookie
   [repository data]
-  (let [[session mac] (.split data "--")]
-    (if (= mac (session-hmac repository session))
-      (unmarshal (session-crypt repository decrypt session)))))
+  (unseal data))

 (defmethod write-session :cookie
   [repository session])


spec migration and ndc fixes

spec migration and ndc fixes

--- src/corpus_utils/bccwj.clj
+++ src/corpus_utils/bccwj.clj
@@ -1,33 +1,40 @@
 (ns corpus-utils.bccwj
-  (:require ;;[clojure.zip :as z]
-            [fast-zip.core :as fz]
-            [clojure.xml :as xml]
-            [clojure.java.io :as io]
-            [clojure.string :as string]
-            [clojure.core.reducers :as r]
-            ;;[org.httpkit.client :as http]
-            [plumbing.core :refer [for-map map-vals]]
-            [schema.core :as s]
-            [corpus-utils.c-code :refer [c-code]]
-            [corpus-utils.utils :as utils]
-            [corpus-utils.document :refer [MetadataSchema DocumentSchema SentencesSchema]])
+  (:require
+    [fast-zip.core :as fz]
+    [clojure.xml :as xml]
+    [clojure.java.io :as io]
+    [clojure.string :as string]
+    [clojure.core.reducers :as r]
+    ;;[org.httpkit.client :as http]
+    [plumbing.core :refer [for-map map-vals]]
+    [clojure.spec.alpha :as s]
+    [corpus-utils.ndc :as ndc]
+    [corpus-utils.c-code :refer [c-code]]
+    [corpus-utils.utils :as utils]
+    [corpus-utils.document]
+    [me.raynes.fs :as fs])
   (:import [fast_zip.core ZipperLocation]
-           [java.util.zip ZipFile ZipEntry]))
+           [java.io File InputStream]
+           [org.apache.commons.compress.archivers.zip ZipFile ZipArchiveEntry]))

 ;; # Importer for BCCWJ-Formatted C-XML Data
 ;;
 ;; Imports C-XML-type data.
 ;; M-XML is also supported, but is not recommended as we do our own parsing.

-
 ;; ## Utility functions
-;; TODO integration
-(s/defn walk-zip-files
-  [zip-name :- java.io.File]
-  (let [z (ZipFile. zip-name)]
-    (for [e (enumeration-seq (.entries z))
-          :when (not (.isDirectory ^ZipEntry e))]
-      (.getInputStream z e))))
+(defn walk-zip-file
+  [apply-fn path]
+  (with-open [z (ZipFile. (fs/file path))]
+    (let [files (enumeration-seq (.getEntries z))]
+      (doall (for [file files
+                   :let [filename (.getName ^ZipArchiveEntry file)]
+                   :when (and (not (.isDirectory file)) (= ".xml" (string/lower-case (fs/extension filename))))]
+               (apply-fn (fs/base-name filename true) (.getInputStream z file)))))))
+
+(s/fdef walk-zip-file
+  :args (s/cat :zip-file #(instance? File %))
+  :ret (s/coll-of #(instance? InputStream %)))

 ;; ## XML Tags
 ;;
@@ -44,16 +51,16 @@
     :list
     :paragraph
     :verse
-    :br ; Inline tag. TODO: find example where this is right or wrong.
+    :br                                                     ; Inline tag.
     :speech
-    :speaker ; For OM.
+    :speaker                                                ; For OM.
     :caption
     :citation
     :quotation
     :OCAnswer
     :OCQuestion})

-(comment ; Not used at present. The text attr should not be used as a string in the sentence.
+(comment                                                    ; Not used at present. The text attr should not be used as a string in the sentence.
   (def in-sentence-tags
     #{:ruby
       :correction
@@ -61,9 +68,9 @@
       :enclosedCharacter
       :er
       :cursive
-      :image ;; Inline tag (Emoji).
-      :noteBodyInline ;; Inline tag.
-      :noteMarker ;; Inline tag.
+      :image                                                ;; Inline tag (Emoji).
+      :noteBodyInline                                       ;; Inline tag.
+      :noteMarker                                           ;; Inline tag.
       :superScript
       :subScript
       :fraction
@@ -86,21 +93,27 @@
 ;;      {:tags #{ ... },
 ;;       :sentences [ ... ]}]

-(s/defn backtrack-with-distance :- {:loc ZipperLocation :depth s/Num}
+(defn backtrack-with-distance
   "Modified from `fast-zip.core/next` source. Like zip/next, but also keeps track of how far up the tree it goes."
-  [loc :- ZipperLocation]
+  [loc]
   (loop [p loc
          depth 0]
     (if (and (not (identical? :end (.path p))) (fz/up p))
       (or (if-let [r (fz/right (fz/up p))] {:loc r :depth (inc depth)}) (recur (fz/up p) (inc depth)))
-      {:loc (ZipperLocation. (.ops loc) (.node loc) :end)
+      {:loc   (ZipperLocation. (.ops loc) (.node loc) :end)
        :depth depth})))

+(s/def ::loc #(instance? ZipperLocation %))
+(s/def ::depth int?)
+(s/fdef backtrack-with-distance
+  :args (s/cat :loc ::loc)
+  :ret (s/keys :req-un [::loc ::depth]))
+
 ;; FIXME break into emitter and consume-sequence-and-build-sentences functions; naming: next-direction conflates direction and depth

-(s/defn walk-and-emit
+(defn walk-and-emit
   "Traverses xml-data (parsed with clojure.xml/parse or clojure.data.xml/parse) using a zipper and incrementally builds up and returns the document as a vector of maps (representing paragraphs), each element of which contains tags and a vector of sentences."
-  [xml-data]
+  [paragraph-level-tags xml-data]
   (loop [xml-loc (fz/xml-zip xml-data)
          tag-stack []
          par-loc (fz/down (fz/vector-zip [{:tags [] :sentences []}]))]
@@ -108,9 +121,9 @@
       (fz/root par-loc)
       (let [xml-node (fz/node xml-loc)
             tag (:tag xml-node)
-            xml-loc-down  (and (fz/branch? xml-loc) (fz/down xml-loc))
+            xml-loc-down (and (fz/branch? xml-loc) (fz/down xml-loc))
             xml-loc-right (and (not xml-loc-down) (fz/right xml-loc))
-            xml-loc-up    (and (not xml-loc-down) (not xml-loc-right) (backtrack-with-distance xml-loc)) ; At lowest depth for this paragraph.
+            xml-loc-up (and (not xml-loc-down) (not xml-loc-right) (backtrack-with-distance xml-loc)) ; At lowest depth for this paragraph.
             next-direction (cond xml-loc-down :down
                                  xml-loc-right :same
                                  :else (:depth xml-loc-up))
@@ -121,19 +134,43 @@
                             :same (if (= :br tag) tag-stack (conj (pop tag-stack) coded-tag)) ; :br is an exception as a paragraph break, as it does not increase XML tree depth
                             ((apply comp (repeat next-direction pop)) tag-stack))] ; Discard equal to up depth.
         (recur
-         (or xml-loc-down xml-loc-right (:loc xml-loc-up)) ; Same as (fz/next xml-loc).
-         new-tag-stack
-         (cond (paragraph-level-tags tag) ; Insert new paragraph, inserting the new tag stack.
-               (-> par-loc (fz/insert-right {:tags new-tag-stack :sentences [""]}) fz/right)
-
-               (= :sentence tag) ; Insert new sentence.
-               (let [tag-stack (-> par-loc fz/node :tag-stack)]
-                 (fz/edit par-loc update-in [:sentences] conj ""))
-
-               (string? xml-node) ; Update last-inserted sentence's text.
-               (fz/edit par-loc update-in [:sentences (-> par-loc fz/node :sentences count dec)] #(str % xml-node))
-
-               :else par-loc)))))) ; Do nothing.
+          (or xml-loc-down xml-loc-right (:loc xml-loc-up)) ; Same as (fz/next xml-loc).
+          new-tag-stack
+          (cond (paragraph-level-tags tag)                  ; Insert new paragraph, inserting the new tag stack.
+                (-> par-loc (fz/insert-right {:tags new-tag-stack :sentences [""]}) fz/right)
+
+                (= :sentence tag)                           ; Insert new sentence.
+                (let [tag-stack (-> par-loc fz/node :tag-stack)]
+                  ;; FIXME debug tag-stack
+                  (fz/edit par-loc update-in [:sentences] conj ""))
+
+                (string? xml-node)                          ; Update last-inserted sentence's text.
+                (fz/edit par-loc update-in [:sentences (-> par-loc fz/node :sentences count dec)] #(str % xml-node))
+
+                :else par-loc))))))                         ; Do nothing.
+
+(s/fdef walk-and-emit
+  :args (s/cat :paragraph-level-tags set? :xml-data any?)
+  :ret :corpus/document)
+
+(defn parse-document
+  [stream corpus]
+  (let [p-tags (case corpus
+                 "OY" (disj paragraph-level-tags :br)
+                 paragraph-level-tags)
+        document (->> stream
+                      xml/parse
+                      (walk-and-emit p-tags))]
+    (into []
+          (comp (map #(hash-map                             ; Remove nils/empty strings from :tags and :sentences.
+                        :paragraph/tags (into #{} (filter identity) (:tags %))
+                        :paragraph/sentences (into [] (remove empty?) (:sentences %))))
+                (remove #(empty? (:paragraph/sentences %)))) ; Remove paragraphs with no sentences.
+          document)))
+
+(s/fdef parse-document
+  :args (s/cat :stream #(instance? InputStream %) :corpus string?)
+  :ret :document/paragraphs)

 ;; ## Metadata
 ;;
@@ -156,99 +193,124 @@
         (println "Failed, exception is " error)
         (println "Async HTTP POST: " status)))))

-(s/defn parse-metadata :- [MetadataSchema]
-  [metadata-dir :- s/Str]
-  ;; metadata-dir "/data/BCCWJ-2012-dvd1/DOC/"
-  (let [metadata  (utils/read-tsv (str metadata-dir "Joined_info.txt") true)
+(defn parse-metadata
+  [metadata-dir]
+  (let [metadata (utils/read-tsv (str metadata-dir "Joined_info.txt") true)
+        fixed-ndc (utils/read-tsv (str metadata-dir "BCCWJ-NDC.txt") true)
         copyright (into {} (utils/read-tsv (str metadata-dir "CopyRight_Annotation.txt") true))
-        ndc-map   (into {} (utils/read-tsv-URL (io/resource "ndc-3digits.tsv") false))
-        c-map     (for-map [[k1 v1] (c-code "1")
-                            [k2 v2] (c-code "2")
-                            [k3 v3] (c-code "34")]
-                           (str k1 k2 k3) {:audience v1 :media v2 :topic v3})
-        name-map  {"LB" "書籍"
-                   "PB" "書籍"
-                   "OB" "書籍"
-                   "OL" "法律"
-                   "OW" "白書"
-                   "OM" "国会会議録"
-                   "OP" "広報紙"
-                   "PN" "新聞"
-                   "PM" "雑誌"
-                   "OV" "韻文"
-                   "OT" "検定教科書"
-                   "OY" "Yahoo!ブログ"
-                   "OC" "Yahoo!知恵袋"}
+        ndc-map (into {} (utils/read-tsv-URL (io/resource "ndc-3digits.tsv") false))
+        c-map (for-map [[k1 v1] (c-code "1")
+                        [k2 v2] (c-code "2")
+                        [k3 v3] (c-code "34")]
+                (str k1 k2 k3) #:metadata{:audience v1 :media v2 :topic v3})
+        name-map {"LB" "書籍"
+                  "PB" "書籍"
+                  "OB" "書籍"
+                  "OL" "法律"
+                  "OW" "白書"
+                  "OM" "国会会議録"
+                  "OP" "広報紙"
+                  "PN" "新聞"
+                  "PM" "雑誌"
+                  "OV" "韻文"
+                  "OT" "検定教科書"
+                  "OY" "Yahoo!ブログ"
+                  "OC" "Yahoo!知恵袋"}
+
+        ndc-metadata
+        (r/reduce
+          (r/monoid
+            (fn [m [ndc basename _ title subtitle number-volume _ publisher year isbn _
+                    genre-1 genre-2 genre-3 genre-4 _ _
+                    author author-year author-gender corpus-name]]
+              ;; We replace the second genre field with the more informative ndc field. genre-1 is the top NDC category.
+              ;; genre-3 is the c-code, and genre-4 is unused for the books corpus.
+              (assoc m basename [genre-1 ndc genre-3 genre-4]))
+            (fn [] {}))
+          fixed-ndc)

         bccwj-metadata
         (r/reduce
-         (r/monoid
-          (fn [m
-              [basename _ title subtitle _ _ publisher year isbn _
-               genre-1 genre-2 genre-3 genre-4 _ _
-               author author-year author-gender corpus-name]]
-            (assoc m basename
-             {:title     (str title (if-not (= "" (string/trim subtitle)) ": " subtitle))
-              :author    author
-              :gender    (let [authors (string/split author-gender #"/")]
-                           (if (every? #(= (first authors) %) authors)
-                             (case (first authors)
-                               "男" :male
-                               "女" :female
-                               ""   nil
-                               :mixed)))
-              :author-year (try (Integer/parseInt author-year) (catch Exception e))
-              :publisher (if (empty? publisher) "BCCWJ" publisher)
-              :copyright (copyright basename)
-              :audience  (if (= (name-map corpus-name) "書籍") (:audience (c-map genre-3)))
-              :media     (if (= (name-map corpus-name) "書籍") (:media (c-map genre-3)))
-              :topic     (if (= (name-map corpus-name) "書籍") (:topic (c-map genre-3)))
-              :year      (Integer/parseInt year)
-              :basename  basename
-              :corpus    "BCCWJ"
-              :subcorpus corpus-name
-              ;;:subcorpus-ja (name-map corpus-name) ;; FIXME
-              :category (->> (condp re-seq corpus-name
-                               #"(L|O|P)B" (->> [genre-1 genre-2 genre-3 genre-4]
-                                                (r/map #(ndc-map % %))
-                                                (r/map #(string/replace % #"^\d\s" ""))
-                                                (r/remove #(= "分類なし" %)) ;; Should be replaced with C-CODE. FIXME ["分類なし" "8328"]
-                                                (r/remove #(re-seq #"^\d{4}$" %))
-                                                #_(r/map #(c-map % %)))
-                               #"OL" (r/map #(string/replace % #"\d\d\s" "")
-                                            [genre-1 genre-2 genre-3 genre-4])
-                               #"OT" [genre-1 (str "G" (case genre-2
-                                                         "小" (Integer/parseInt genre-3)
-                                                         "中" (+ 6 (Integer/parseInt genre-3))
-                                                         "高" 10))]
-                               [genre-1 genre-2 genre-3 genre-4])
-                             (r/remove empty?)
-                             (r/reduce (fn ;; Remove repeated categories.
-                                         ([] [])
-                                         ([a b] (if (= (peek a) b) a (conj a b)))))
-                             (concat [(name-map corpus-name)])
-                             (into []))}))
-          (fn [] {}))
-         metadata)
+          (r/monoid
+            (fn [m
+                 [basename _ title subtitle _ _ publisher year isbn _
+                  genre-1 genre-2 genre-3 genre-4 _ _
+                  author author-year author-gender corpus-name]]
+              (let [metadata-patch? (if-let [v (get ndc-metadata basename)] v false)
+                    [genre-1 genre-2 genre-3 genre-4] (if metadata-patch? metadata-patch? [genre-1 genre-2 genre-3 genre-4])]
+                (assoc m basename
+                         #:metadata{:title       (str title (if-not (= "" (string/trim subtitle)) ": " subtitle))
+                                    :author      author
+                                    :gender      (let [authors (string/split author-gender #"/")]
+                                                   (if (every? #(= (first authors) %) authors)
+                                                     (case (first authors)
+                                                       "男" :male
+                                                       "女" :female
+                                                       "" nil
+                                                       :mixed)))
+                                    :author-year (try (Integer/parseInt author-year) (catch Exception e))
+                                    :publisher   (if (empty? publisher) "BCCWJ" publisher)
+                                    :copyright   (copyright basename)
+                                    :audience    (if (= (name-map corpus-name) "書籍") (:metadata/audience (c-map genre-3)))
+                                    :media       (if (= (name-map corpus-name) "書籍") (:metadata/media (c-map genre-3)))
+                                    :topic       (if (= (name-map corpus-name) "書籍") (:metadata/topic (c-map genre-3)))
+                                    :year        (Integer/parseInt year)
+                                    :basename    basename
+                                    :corpus      "BCCWJ"
+                                    :subcorpus   (name-map corpus-name)
+                                    :category    (->> (condp re-seq corpus-name
+                                                        #"(L|O|P)B" (->> [genre-1 genre-2]
+                                                                         (r/remove #(or (= "なし" %)
+                                                                                (= "分類なし" %)))
+                                                                         (r/mapcat #(ndc/ndc-map % [%]))
+                                                                         (r/map #(string/replace % #"^\d\s" ""))
+                                                                         (r/mapcat #(condp re-seq %
+
+                                                                                #"^(\d+)\.(\d+)$"
+                                                                                (let [[[_ top-level extra] & _] (re-seq #"^(\d+)\.(\d+)$" %)]
+                                                                                ;; We fallback on the top-level NDC concept if no direct match is found.
+                                                                                (get ndc/ndc-map top-level))
+
+                                                                                #"^[\d\s]+$"
+                                                                                (do (println "Removing unknown category: " basename genre-1 genre-2)
+                                                                                [nil])
+
+                                                                                [%]))
+                                                                         (r/remove nil?))
+                                                        #"OL" (r/map #(string/replace % #"\d\d\s" "")
+                                                                     [genre-1 genre-2 genre-3 genre-4])
+                                                        #"OT" [genre-1 (str "G" (case genre-2
+                                                                                "小" (Integer/parseInt genre-3)
+                                                                                "中" (+ 6 (Integer/parseInt genre-3))
+                                                                                "高" 10))]
+                                                        [genre-1 genre-2 genre-3 genre-4])
+                                                      (r/remove empty?)
+                                                      (r/reduce (fn ;; Remove repeated categories.
+                                                                  ([] [])
+                                                                  ([a b] (if (= (peek a) b) a (conj a b)))))
+                                                      (concat [(name-map corpus-name)])
+                                                      (into []))})))
+            (fn [] {}))
+          metadata)

         bccwj-meta-annotation-data (utils/read-tsv-xz (io/resource "annotations-2013.tsv.xz") false)
         bccwj-annotations
-        (let [header [:forward-or-afterward #_"前書きや後書きか"
-                      :dialog #_"対話系か"
-                      :quotation-type #_"引用系か"
-                      :visual #_"視覚表現多用系（図表・イラスト・写真の多用）か"
-                      :db-or-list #_"データベースやリスト系か"
-                      :archaic #_"明治時代より以前の古い言葉，古い言い回しが多いか"
-                      :foreign-language #_"外国語が多いか"
-                      :math-or-code #_"数式やプログラミング言語などが多いか"
-                      :legalese #_"法律文が多いか"
-                      :questionable-content #_"教育上のぞましくなさそうか"
-                      :low-content #_"そのほか，一定量の「本文」が認めがたいか"
-
-                      :target-audience #_"対象とする読者"
-                      :hard-soft #_"文章の硬軟"
-                      :informality #_"くだけているか"
-                      :addressing #_"文体(O)"
+        (let [header [:metadata/forward-or-afterward #_"前書きや後書きか"
+                      :metadata/dialog #_"対話系か"
+                      :metadata/quotation-type #_"引用系か"
+                      :metadata/visual #_"視覚表現多用系（図表・イラスト・写真の多用）か"
+                      :metadata/db-or-list #_"データベースやリスト系か"
+                      :metadata/archaic #_"明治時代より以前の古い言葉，古い言い回しが多いか"
+                      :metadata/foreign-language #_"外国語が多いか"
+                      :metadata/math-or-code #_"数式やプログラミング言語などが多いか"
+                      :metadata/legalese #_"法律文が多いか"
+                      :metadata/questionable-content #_"教育上のぞましくなさそうか"
+                      :metadata/low-content #_"そのほか，一定量の「本文」が認めがたいか"
+
+                      :metadata/target-audience #_"対象とする読者"
+                      :metadata/hard-soft #_"文章の硬軟"
+                      :metadata/informality #_"くだけているか"
+                      :metadata/addressing #_"文体(O)"

                       :_ #_"小説の主人公あるいは語り手の人称(H)"
                       :_ #_"小説の主人公あるいは語り手の人称(M)"
@@ -256,76 +318,52 @@
                       :_ #_"小説の主人公あるいは語り手の人称(T)"
                       :_ #_"小説の主人公あるいは語り手の人称(N)"

-                      :protagonist-personal-pronoun #_"小説の主人公あるいは語り手の人称"
-                      :other-addressing #_"小説以外の文章の内容"]
-              #_(->> bccwj-meta-annotation-data
-                     first
-                     rest)]
+                      :metadata/protagonist-personal-pronoun #_"小説の主人公あるいは語り手の人称"
+                      :metadata/other-addressing #_"小説以外の文章の内容"]]
           (r/fold
-           (r/monoid
-            (fn [a [basename & record]]
-              (assoc a basename
-                     (for-map [[k v] (zipmap header record)
-                               :when (not= k :_)]
-                         k (cond (empty? v) nil
-
-                                 ;; Coerce into Likert-scale Longs.
-                                 (and (#{:target-audience :hard-soft :informality :addressing :other-addressing} k)
-                                      (re-seq #"^\d+" v))
-                                 (Long/parseLong v)
-
-                                 ;; Coerce into binary values.
-                                 (#{:forward-or-afterward :dialog
-                                     :quotation-type :visual
-                                     :db-or-list :archaic
-                                     :foreign-language :math-or-code
-                                     :legalese :questionable-content
-                                     :low-content} k)
-                                 (case (subs v 0 1) "1" true "0" false true)
-
-                                 :else v))))
-            (fn [] {}))
-           (next bccwj-meta-annotation-data)))]
+            (r/monoid
+              (fn [a [basename & record]]
+                (assoc a basename
+                         (for-map [[k v] (zipmap header record)
+                                   :when (not= k :_)]
+                           k (cond (empty? v) nil
+
+                                   ;; Coerce into Likert-scale Longs.
+                                   (and (#{:metadata/target-audience :metadata/hard-soft :metadata/informality
+                                           :metadata/addressing :metadata/other-addressing}
+                                         k)
+                                        (re-seq #"^\d+" v))
+                                   (Long/parseLong v)
+
+                                   ;; Coerce into binary values.
+                                   (#{:metadata/forward-or-afterward :metadata/dialog :metadata/quotation-type
+                                      :metadata/visual :metadata/db-or-list :metadata/archaic :metadata/foreign-language
+                                      :metadata/math-or-code :metadata/legalese :metadata/questionable-content
+                                      :metadata/low-content}
+                                    k)
+                                   (case (subs v 0 1) "1" true "0" false true)
+
+                                   :else v))))
+              (fn [] {}))
+            (next bccwj-meta-annotation-data)))]

     (->> (merge-with merge bccwj-metadata bccwj-annotations)
-         (map-vals (fn [vs] (into {} (r/remove #(nil? (val %)) vs))))
-         vals)))
-
-(comment
-  (pprint (take 10 (map (comp :category :metadata) (filter #(= ((comp :subcorpus :metadata) %) "PM") (document-seq "/data/BCCWJ-2012-dvd1/DOC/" "/data/BCCWJ-2012-dvd1/C-XML/VARIABLE/")))))
-  (def cats (into #{} (map (comp :category :metadata) (document-seq "/data/BCCWJ-2012-dvd1/DOC/" "/data/BCCWJ-2012-dvd1/C-XML/VARIABLE/"))))
-  (def c-topics (into #{} (map :topic (mapcat (comp #(remove empty? %) #(filter map? %)) cats))))
-  (def c-audiences (into #{} (map :audience (mapcat (comp #(remove empty? %) #(filter map? %)) cats))))
-  (def c-medias (into #{} (map :media (mapcat (comp #(remove empty? %) #(filter map? %)) cats))))
-  (def ndc-topics (into #{} (mapcat (comp #(remove empty? %) #(remove map? %)) cats)))
-  (clojure.set/intersection c-topics ndc-topics)
-  ;; How to merge these intersecting labels that are recorded at different levels?
-  #{"情報科学" "宗教" "商業" "旅行" "物理学" "総記" "仏教" "キリスト教" "化学" "機械" "哲学" "ドイツ語" "家事" "法律" "数学" "日本語" "教育" "伝記" "社会" "生物学" "水産業"}
-)
-
-(s/defn parse-document :- SentencesSchema
-  [filename :- s/Str]
-  (->> filename
-       io/input-stream
-       xml/parse
-       walk-and-emit
-       (map #(hash-map ; Remove nils/empty strings from :tags and :sentences.
-              :tags (into #{} (r/filter identity (:tags %)))
-              :sentences (into [] (r/remove empty? (:sentences %)))))
-       (remove #(empty? (:sentences %))) ; Remove paragraphs with no sentences.
-       vec))
-
-(s/defn document-seq :- [DocumentSchema] ;; TODO validate lazy-seq?
-  [options :- {:corpus-dir s/Str
-               :metadata-dir s/Str
-               s/Keyword s/Any}]
-  (lazy-seq
-   (->> (parse-metadata (:metadata-dir options))
-        (map (fn [metadata]
-               (let [filename (str (:corpus-dir options) (:subcorpus metadata) "/" (:basename metadata) ".xml")]
-                 {:metadata metadata
-                  :paragraphs (parse-document filename)}))))))
-
-(comment
-  (s/with-fn-validation
-   (take 10 (map (comp :category :metadata) (document-seq "/data/BCCWJ-2012-dvd1/DOC/" "/data/BCCWJ-2012-dvd1/C-XML/VARIABLE/")))))
+         (map-vals (fn [vs] (into {} (r/remove #(nil? (val %)) vs)))))))
+
+(s/fdef parse-metadata
+  :args (s/cat :metadata-dir string?)
+  :ret (s/map-of :metadata/basename :document/metadata))
+
+(defn document-seq
+  [options]
+  (let [metadata (parse-metadata (:metadata-dir options))]
+    (walk-zip-file
+      (fn [basename text]
+        (let [meta (get metadata basename)]
+          {:document/metadata   meta
+           :document/paragraphs (parse-document text (:subcorpus meta))}))
+      (:corpus-dir options))))
+
+(s/fdef document-seq
+  :args (s/cat :options (s/keys :req-un [:corpus/dir string? :metadata/dir string?]))
+  :ret :corpus/documents)


Add enable and disable-tracing functions

Hard coded at the moment to disable/enable when showing the panel. Will
be eventually made configurable.

Fixes #7

--- src/day8/re_frame/trace.cljs
+++ src/day8/re_frame/trace.cljs
@@ -103,10 +103,17 @@
     #_(if-let [comp-p (get-in trace [:tags :component-path])]
         (println comp-p))))

-(defn init-tracing! []
+(defn disable-tracing! []
+  (re-frame.trace/remove-trace-cb ::cb))
+
+(defn enable-tracing! []
   (re-frame.trace/register-trace-cb ::cb (fn [new-traces]
                                            (let [new-traces (filter log-trace? new-traces)]
-                                             (swap! traces #(reduce conj % new-traces)))))
+                                             (swap! traces #(reduce conj % new-traces))))))
+
+(defn init-tracing!
+  "Sets up any intial state that needs to be there for tracing. Does not enable tracing."
+  []
   (monkey-patch-reagent)
   )

@@ -206,6 +213,9 @@
                              (cond
                                (and (= key "h") (.-ctrlKey e))
                                (do (swap! showing? not)
+                                   (if @showing?
+                                     (enable-tracing!)
+                                     (disable-tracing!))
                                    (.preventDefault e))))))]
     (r/create-class
       {:component-will-mount   #(js/window.addEventListener "keydown" handle-keys)


Add initial monsters to level0 when it is generated

--- src/dungeon_crusade/main.clj
+++ src/dungeon_crusade/main.clj
@@ -72,8 +72,10 @@
         _ (info "dialogs" (apply merge (map :dialog quests)))
         dialog (apply merge (map (fn [[k v]]
                                    {k (dialog->fsm v)})
-                                 (apply merge (map :dialog quests))))]
+                                 (apply merge (map :dialog quests))))
+        state {:world world :screen terminal :quests quest-map :dialog dialog}
+        state (reduce (fn [state _] (add-npcs state 1)) state (range 500))]

     ;; tick once using the rest (.) command to update visibility
-    (tick {:world world :screen terminal :quests quest-map :dialog dialog} \.)))
+    (tick state \.)))


Fix spelling error.

Fix spelling error.

--- src/forces_assemble/db.clj
+++ src/forces_assemble/db.clj
@@ -1,4 +1,4 @@
-(ns focrces-assemble.db
+(ns forces-assemble.db
   (:require [clojure.set]
             [forces-assemble.config :as config]
             [environ.core :refer [env]]


devtools ui: added border between actions

--- src/frontend/devtools.cljs
+++ src/frontend/devtools.cljs
@@ -207,6 +207,7 @@
            ^{:key id}
            [:div {:style    {:cursor           "pointer"
                              :margin-left      "10px"
+                             :margin-top       "3px"
                              :background-color "rgb(79, 90, 101)"
                              :color            (if enabled? "inherit" "grey")}
                   :on-click #(dispatch [:on-toggle-action id])


Blake-out previous-track button when disabled

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -246,11 +246,19 @@
   (reify
     om/IRender
     (render [this]
-      (dom/img #js {:id "previous-track"
-                    :className "player-button-img"
-                    :src "/images/player/prev.svg"
-                    :title "Previous Track"
-                    :onClick core/previous-track}))))
+      (if (nil? (:current-track-id data))
+        (dom/img #js {:className "player-button-img"
+                      :src grey-out-image})
+        (if (< 0
+               (.-tracknum (core/get-music-info-from-id (:current-track-id data))))
+          (dom/img #js {:id "previous-track"
+                        :className "player-button-img"
+                        :src "/images/player/prev.svg"
+                        :title "Previous Track"
+                        :onClick core/previous-track})
+
+          (dom/img #js {:className "player-button-img"
+                        :src grey-out-image}))))))

 (defn next-track-button [data owner]
   (reify


fixed #133

fixed #133

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -107,8 +107,11 @@
            "HASHING: "
            (:name file-hash-info)
            " - "
-           (* 100 (/ (:current-chunk file-hash-info)
-                  (:chunks file-hash-info)))
+           (if (< (:current-chunk file-hash-info)
+                  (:chunks file-hash-info))
+             (* 100 (/ (:current-chunk file-hash-info)
+                       (:chunks file-hash-info)))
+             100)
            "%"))

 (defn build-upload-id-view [upload-data owner]


disable indexing for the event entity field index field

--- src/ctia/stores/es/mapping.clj
+++ src/ctia/stores/es/mapping.clj
@@ -621,7 +621,8 @@
     {:owner token
      :groups token
      :timestamp ts
-     :entity {:type "object"}
+     :entity {:enabled false
+              :type "object"}
      :id token
      :http-params {:type "object"}
      :type token


Turn off dev options for standalone jar

Turn off dev options for standalone jar

--- src/leiningen/ring/jar.clj
+++ src/leiningen/ring/jar.clj
@@ -13,14 +13,17 @@
       (default-main-namespace project)))

 (defn compile-main [project]
-  (let [main-ns (symbol (main-namespace project))]
+  (let [main-ns (symbol (main-namespace project))
+        options (-> (select-keys project [:ring])
+                    (assoc-in [:ring :open-browser?] false)
+                    (assoc-in [:ring :stacktraces?] false)
+                    (assoc-in [:ring :auto-reload?] false))]
     (compile-form project main-ns
       `(do (ns ~main-ns
              (:require ring.server.leiningen)
              (:gen-class))
            (defn ~'-main []
-             (ring.server.leiningen/serve
-              '~(select-keys project [:ring])))))))
+             (ring.server.leiningen/serve '~options))))))

 (defn add-main-class [project]
   (update-project project assoc :main (symbol (main-namespace project))))


Better group ids and logging

Better group ids and logging

--- src/lib/clj/one/reload.clj
+++ src/lib/clj/one/reload.clj
@@ -15,6 +15,11 @@
   (:use [cljs.closure :only (build -compile Compilable)]
         [cljs.compiler :only (to-target-file)])
   (:require [clojure.java.io :as io]))
+
+(def ^:dynamic *logging* false)
+
+(defn log [& s]
+  (when *logging* (apply prn s)))

 ;; Reloading Protocols
 ;; ===================
@@ -43,6 +48,7 @@
   "Reload a sequence of Clojure files."
   [files]
   (doseq [f files]
+    (log "Reloading file :: " f)
     (reload-clj f)))

 (defn- by-extension
@@ -85,6 +91,8 @@
 ;; used to filter the returned files.

 (defrecord Directories [dirs pred sort-fn]
+  IGroupable
+  (group-id [_ _] dirs)
   ISources
   (files [this]
     (let [sort-fn (or sort-fn identity)]
@@ -97,6 +105,8 @@
 ;; be compiled as one unit.

 (defrecord ClojureScriptDirs [dirs]
+  IGroupable
+  (group-id [_ _] dirs)
   ISources
   (files [this]
     (all-descendants-ending-with dirs ".cljs"))
@@ -131,6 +141,8 @@
 ;; ClojureScript and for this to work with code reloading.

 (defrecord Shared [dir pred]
+  IGroupable
+  (group-id [_ request] dir)
   ISources
   (files [this]
     (filter-descendants dir pred))
@@ -148,9 +160,10 @@

 (defrecord ClojureReloadable [sources]
   IGroupable
-  (group-id [_ request] [::clj sources])
+  (group-id [_ request] [::clj (map #(group-id % request) sources)])
   IReloadable
   (reload [_ _]
+    (log "ClojureReloadable :: " sources)
     (doseq [source sources]
       (reload-clj-seq (files source))))
   ISources
@@ -210,9 +223,10 @@

 (defrecord ClojureScriptReloadable [opts sources top-level-pkgs]
   IGroupable
-  (group-id [_ request] [::cljs (:uri request)])
+  (group-id [_ request] [::cljs (map #(group-id % request) sources) (:uri request)])
   IReloadable
   (reload [this request]
+    (log "ClojureScriptReloadable :: " sources)
     (let [build-opts (cljs-compilation-options opts request)]
       (doseq [pkg top-level-pkgs]
         (doseq [file (files-in-dir (jstr opts "/out/" pkg))]
@@ -230,9 +244,11 @@

 (defrecord Watch [source]
   IGroupable
-  (group-id [_ request] [::dir (:dirs source) (:uri request)])
+  (group-id [_ request] [::dir (group-id source request) (:uri request)])
   IReloadable
-  (reload [_ request] nil)
+  (reload [_ request]
+    (log "Watch :: " source)
+    nil)
   ISources
   (files [_] (files source)))

@@ -269,6 +285,7 @@
   (def clj-dirs (->Directories ["src/app/clj" "src/lib/clj"]
                                (by-file-name clojure-files)
                                (fn [xs] (sort-by (name-order clojure-files) xs))))
+  (group-id clj-dirs {})
   (files clj-dirs)

   ;; Make this group of files Reloadable


Refactor search-page-view; don't need closure or reaction

--- src/braid/client/ui/views/pages/search.cljs
+++ src/braid/client/ui/views/pages/search.cljs
@@ -6,7 +6,7 @@
     [reagent.core :as r]
     [reagent.ratom :include-macros true :refer-macros [reaction]]))

-(def user-uuid-re #"^@([a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12})$")
+(def user-uuid-re #"@([a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12})")

 (defn search-page-view
   []
@@ -14,93 +14,91 @@
         threads (subscribe [:threads])
         query (subscribe [:search-query])
         group-id (subscribe [:open-group-id])
-        user-search (reaction (some->> @query (re-matches user-uuid-re)
-                                       second uuid))]
-    (fn []
-      (let [status (cond
-                     (@page :search-error?) :error
-                     (@page :loading?) :loading
-                     (not (contains? @page :thread-ids)) :searching
-                     (seq (@page :thread-ids)) :done-results
-                     :else :done-empty)]
+        user-search (some->> @query (re-find user-uuid-re)
+                             second uuid)
+       status (cond
+                   (@page :search-error?) :error
+                   (@page :loading?) :loading
+                   (not (contains? @page :thread-ids)) :searching
+                   (seq (@page :thread-ids)) :done-results
+                   :else :done-empty)]
+    (case status
+      :searching
+      [:div.page.search
+       [:div.title (str "Search for \"" @query "\"")]
+       [:div.content
+        [:div.description
+         "Searching..."]
+        (when user-search [user-card-view user-search])]]

-        (case status
-          :searching
-          [:div.page.search
-           [:div.title (str "Search for \"" @query "\"")]
-           [:div.content
-            [:div.description
-             "Searching..."]
-            (when-let [uid @user-search] [user-card-view uid])]]
+      :error
+      [:div.page.search
+       [:div.title (str "Search for \"" @query "\"")]
+       [:div.content
+        [:p "Search timed out"]
+        [:button
+         {:on-click
+          (fn [_]
+            (dispatch [:search-history [(@page :search-query) @group-id]]))}
+         "Try again"]
+        (when user-search [user-card-view user-search])]]

-          :error
-          [:div.page.search
-           [:div.title (str "Search for \"" @query "\"")]
-           [:div.content
-            [:p "Search timed out"]
-            [:button
-             {:on-click
-              (fn [_]
-                (dispatch [:search-history [(@page :search-query) @group-id]]))}
-             "Try again"]
-           (when-let [uid @user-search] [user-card-view uid])]]
+      (:done-results :loading)
+      (let [loaded-threads (vals (select-keys @threads (@page :thread-ids)))
+            sorted-threads (->> loaded-threads
+                                        ; sort-by last reply, newest first
+                               (sort-by
+                                 (comp (partial apply max)
+                                       (partial map :created-at)
+                                       :messages)
+                                 #(compare %2 %1)))]
+        [:div.page.search
+         [:div.title (str "Search for \"" @query "\"")]
+         [:div.content
+          [:div.description
+           (if (= status :loading)
+             "Loading more results..."
+             (str "Displaying " (count loaded-threads) "/"
+                  (count (@page :thread-ids))))]]
+         [:div.threads
+          {:on-scroll ; page in more results as the user scrolls
+           (fn [e]
+             (let [div (.. e -target)]
+               (when (and (= (.-className div) "threads")
+                          (= status :done-results)
+                          (< (count loaded-threads) (count (@page :thread-ids)))
+                          (> 100 (- (.-scrollWidth div)
+                                    (+ (.-scrollLeft div) (.-offsetWidth div)))
+                             0))
+                 (dispatch [:set-page-loading true])
+                 (let [already-have (set (map :id loaded-threads))
+                       to-load (->> (@page :thread-ids)
+                                   (remove already-have)
+                                   (take 25))]
+                   (dispatch [:load-threads
+                              {:thread-ids to-load
+                               :on-complete
+                               (fn []
+                                 (dispatch [:set-page-loading false]))}])))))
+           :on-wheel ; make the mouse wheel scroll horizontally
+           (fn [e]
+             (let [target-classes (.. e -target -classList)
+                   this-elt (.. e -target)]
+                                        ; TODO: check if threads-div needs to scroll?
+               (when (and (or (.contains target-classes "thread")
+                              (.contains target-classes "threads"))
+                          (= 0 (.-deltaX e) (.-deltaZ e)))
+                 (set! (.-scrollLeft this-elt)
+                       (- (.-scrollLeft this-elt) (.-deltaY e))))))}
+          (when user-search [user-card-view user-search])
+          (doall
+            (for [thread sorted-threads]
+              ^{:key (:id thread)}
+              [thread-view thread]))]])

-          (:done-results :loading)
-          (let [loaded-threads (vals (select-keys @threads (@page :thread-ids)))
-                sorted-threads (->> loaded-threads
-                                    ; sort-by last reply, newest first
-                                    (sort-by
-                                      (comp (partial apply max)
-                                            (partial map :created-at)
-                                            :messages)
-                                      #(compare %2 %1)))]
-            [:div.page.search
-             [:div.title (str "Search for \"" @query "\"")]
-             [:div.content
-              [:div.description
-               (if (= status :loading)
-                 "Loading more results..."
-                 (str "Displaying " (count loaded-threads) "/"
-                      (count (@page :thread-ids))))]]
-             [:div.threads
-              {:on-scroll ; page in more results as the user scrolls
-               (fn [e]
-                 (let [div (.. e -target)]
-                   (when (and (= (.-className div) "threads")
-                              (= status :done-results)
-                              (< (count loaded-threads) (count (@page :thread-ids)))
-                              (> 100 (- (.-scrollWidth div)
-                                        (+ (.-scrollLeft div) (.-offsetWidth div)))
-                                 0))
-                     (dispatch [:set-page-loading true])
-                     (let [already-have (set (map :id loaded-threads))
-                           to-load (->> (@page :thread-ids)
-                                       (remove already-have)
-                                       (take 25))]
-                       (dispatch [:load-threads
-                                  {:thread-ids to-load
-                                   :on-complete
-                                   (fn []
-                                     (dispatch [:set-page-loading false]))}])))))
-               :on-wheel ; make the mouse wheel scroll horizontally
-               (fn [e]
-                 (let [target-classes (.. e -target -classList)
-                       this-elt (.. e -target)]
-                                        ; TODO: check if threads-div needs to scroll?
-                   (when (and (or (.contains target-classes "thread")
-                                  (.contains target-classes "threads"))
-                              (= 0 (.-deltaX e) (.-deltaZ e)))
-                     (set! (.-scrollLeft this-elt)
-                           (- (.-scrollLeft this-elt) (.-deltaY e))))))}
-              (when-let [uid @user-search] [user-card-view uid])
-              (doall
-                (for [thread sorted-threads]
-                  ^{:key (:id thread)}
-                  [thread-view thread]))]])
-
-          :done-empty
-          [:div.page.search
-           [:div.title (str "Search for \"" @query "\"")]
-           [:div.content
-            [:div.description "No results."]
-            (when-let [uid @user-search] [user-card-view uid])]])))))
+      :done-empty
+      [:div.page.search
+       [:div.title (str "Search for \"" @query "\"")]
+       [:div.content
+        [:div.description "No results."]
+        (when user-search [user-card-view user-search])]])))


:bug: Fix bug on body decoding (backend).

--- backend/src/uxbox/http/middleware.clj
+++ backend/src/uxbox/http/middleware.clj
@@ -21,9 +21,10 @@

 (defn- wrap-parse-request-body
   [handler]
-  (fn [{:keys [headers body] :as request}]
+  (fn [{:keys [headers body method] :as request}]
     (let [mtype (get headers "content-type")]
-      (if (= "application/transit+json" mtype)
+      (if (and (= "application/transit+json" mtype)
+               (not= method :get))
         (try
           (let [params (t/decode (t/buffer->bytes body))]
             (handler (assoc request :body-params params)))


Clean up style stuff

Clean up style stuff

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -212,7 +212,7 @@
               [:br]
        [:p#instruct "Code which fills in the blank: "]
        (text-area {:id "code-box"
-`                   :spellcheck "false"}
+                   :spellcheck "false"}
                   :code (session/flash-get :code))
        [:div#golfgraph
         (render-golf-chart)]
@@ -283,7 +283,6 @@
       (unapproved-problem-page)
       (flash-error "You cannot access this page" "/problems"))))

-
 (def-page problem-submission-page []
   [:div.instructions
     [:p "Thanks for choosing to submit a problem. Please make sure that you own the rights to the code you are submitting and that you wouldn't mind having us use the code as a 4clojure problem."]]
@@ -308,35 +307,34 @@
   [title tags description code id author]
   (let [user (session/session-get :user)]
     (if (can-submit? user)
-      (do
-        (let [prob-id
-              (if (nil? id)
-                (:seq (fetch-and-modify
-                       :seqs
-                       {:_id "problems"}
-                       {:$inc {:seq 1}}))
-                id)]
-          (update! :problems
-                   {:_id prob-id}
-                   {:_id prob-id
-                    :title title
-                    :times-solved 0
-                    :description description
-                    :tags (s/split tags #"\s+")
-                    :tests (s/split-lines code)
-                    :user (if (empty? author) user author)
-                    :approved false}))
+      (let [prob-id (or id
+                        (:seq (fetch-and-modify
+                               :seqs
+                               {:_id "problems"}
+                               {:$inc {:seq 1}})))]
+
+        (update! :problems
+                 {:_id prob-id}
+                 {:_id prob-id
+                  :title title
+                  :times-solved 0
+                  :description description
+                  :tags (s/split tags #"\s+")
+                  :tests (s/split-lines code)
+                  :user (if (empty? author) user author)
+                  :approved false})
         (flash-msg "Thank you for submitting a problem! Be sure to check back to see it posted." "/problems"))
       (flash-error "You are not authorized to submit a problem." "/problems"))))

 (defn edit-problem [id]
   (let [{:keys [title user tags description tests]} (get-problem id)]
-    (session/flash-put! :prob-id id)
-    (session/flash-put! :author user)
-    (session/flash-put! :title title)
-    (session/flash-put! :tags (apply str (interpose " " tags)))
-    (session/flash-put! :description description)
-    (session/flash-put! :tests (apply str (interpose "\n" tests)))
+    (doseq [[k v] {:prob-id id
+                   :author user
+                   :title title
+                   :tags (s/join " " tags)
+                   :description description
+                   :tests (s/join "\n" tests)}]
+      (session/flash-put! k v))
     (response/redirect "/problems/submit")))

 (defn approve-problem [id]


Emacs fixed some whitespace

Emacs fixed some whitespace

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -303,7 +303,7 @@
         [:br]
         [:br]
         [:p#instruct "Code which fills in the blank: "]
-       (when (wants-no-javascript-codebox?) [:span#disable-javascript-codebox])
+        (when (wants-no-javascript-codebox?) [:span#disable-javascript-codebox])
         (text-area {:id "code-box"
                     :spellcheck "false"}
                    :code (escape-html


small fix

small fix

--- src/cljs/salava/metabadge/ui/metabadge.cljs
+++ src/cljs/salava/metabadge/ui/metabadge.cljs
@@ -64,12 +64,13 @@
                          (conj result (reduce (fn [r badge]
                                                 (let [;{:keys [badge-info received current]} badge
                                                        {:keys [user_badge_id name image_file image criteria criteria_content url]} badge
+                                                       image (if image_file (str "/" image_file) image)
                                                        current (if (string? current-badge-id) (= url current-badge-id) (= user_badge_id current-badge-id))]

                                                   (conj r (if user_badge_id
-                                                            [:td [:div [:img.img-circle {:src (str "/" image_file) :alt name :title name :class (if current "img-thumbnail" "")
+                                                            [:td [:div [:img.img-circle {:src image :alt name :title name :class (if current "img-thumbnail" "")
                                                                                }]]]
-                                                            [:td [:div [:img.img-circle.not-received {:src (if image_file (str "/" image_file) image) :alt name :title name} ]]]))))
+                                                            [:td [:div [:img.img-circle.not-received {:src image :alt name :title name} ]]]))))
                                               [:tr]
                                               coll))) [:tbody] (partition-all (partition-count m current-badge-id milestone?) (required-block-badges m current-badge-id milestone?)))]]]]]]]]]))


added some small functions

added some small functions

--- src/friendui/models/user.clj
+++ src/friendui/models/user.clj
@@ -11,6 +11,8 @@

 (defn username-exists [username]
   (if (> (count (find-by-column-and-search-string username-kw username)) 0) true false))
+
+(defn get-logged-in-username [] (:username (friend/current-authentication)))

 (defn create-user [email password role]
@@ -50,9 +52,12 @@
       (merge user (into {} [[:password (pw-kw db-id)]]))
       user)))

-(defn set-user-activated [username]
-  @(d/transact (conn-datomic) [{:db/id [username-kw username], activated-kw true}]))
+(defn get-user-db-entity
+  ([] (get-user-db-entity (get-logged-in-username)))
+  ([username]
+   (get-entity-from-double-vec (find-by-column-and-search-string username-kw username))))

+(defn set-user-activated [username] @(d/transact (conn-datomic) [{:db/id [username-kw username], activated-kw true}]))

 (defn account-activated [activationid]
   (let [id (find-by-column-and-search-string activated-kw activationid)]
@@ -74,10 +79,7 @@
   (if (is-user-activated username)
     (do
       (let [db-id (get-entity-from-double-vec (find-by-column-and-search-string username-kw username))]
-        {:username username :roles (get-roles db-id) :password (pw-kw db-id)}
-      ))
-    )
-  )
+        {:username username :roles (get-roles db-id) :password (pw-kw db-id)}))))

 (defn update-user [username data]
   @(d/transact (conn-datomic) [(merge {:db/id [:user/email username]} data)]))
@@ -90,6 +92,11 @@
             data (get user id)]
         (assoc field :data data)))))

+(defn update-loggedin-user [data] (update-user (get-logged-in-username) data))
+
+(defn is-logged-in [] (friend/anonymous?))
+
+
 (def friend-settings
   {:credential-fn             (partial creds/bcrypt-credential-fn login-user)
    :workflows                 [(workflows/interactive-form)]


Check the Stripe checkout is loaded before displaying card data

--- frontend/components/org_settings.cljs
+++ frontend/components/org_settings.cljs
@@ -458,7 +458,7 @@
       (html
         (let [card (get-in app state/stripe-card-path)
               controls-ch (om/get-shared owner [:comms :controls])]
-          (if-not card
+          (if-not (and card checkout-loaded?)
             [:div.loading-spinner common/spinner]
             [:div
                 [:div.card.row-fluid [:fieldset [:legend.span8 "Card on file"]]]


CMR-5073: More cleanup.

CMR-5073: More cleanup.

--- ingest-app/src/cmr/ingest/api/translation.clj
+++ ingest-app/src/cmr/ingest/api/translation.clj
@@ -63,8 +63,7 @@
   (let [umm (umm-legacy/parse-concept
              context {:concept-type concept-type
                       :format content-type
-                      :metadata body})
-        output-format (mt/mime-type->format accept-header)]
+                      :metadata body})]
     (if-let [umm-errors (when-not skip-umm-validation (umm-errors context concept-type umm))]
       (errors/throw-service-errors :invalid-data umm-errors)
       (translate-response context umm accept-header))))
@@ -113,8 +112,7 @@
   "This defines routes for development purposes that can generate random metadata and return it."
   (GET "/random-metadata" {:keys [body headers request-context]}
     (let [supported-formats (concept-type->supported-formats :collection)
-          output-mime-type (mt/extract-header-mime-type supported-formats headers "accept" true)
-          output-format (mt/mime-type->format output-mime-type)]
+          output-mime-type (mt/extract-header-mime-type supported-formats headers "accept" true)]

       (let [umm (test-check-gen/generate umm-generators/umm-c-generator)
             output-str (umm-spec/generate-metadata umm output-mime-type)]


Fix performance issue with re-creating AWT Polygon instances too often.

--- Clojure/clojuroids.clj
+++ Clojure/clojuroids.clj
@@ -65,7 +65,7 @@
         (let [old-transform (.getTransform g)]
             (.translate g (:x asteroid) (:y asteroid))
             (.rotate g (:a asteroid))
-            (.fill g (asteroid-shape (:radii asteroid)))
+            (.fill g (:poly asteroid))
             (.setTransform g old-transform))))

 (defn draw-bullet [bullet g]
@@ -124,7 +124,7 @@
             (- (:x bullet) (:x asteroid))
             (- (:y bullet) (:y asteroid))
             (:a asteroid))
-        p (asteroid-shape (:radii asteroid))]
+        p (:poly asteroid)]
         (.contains p x y)))

 (defn filter-collisions [bullets asteroids]
@@ -141,15 +141,18 @@
             asteroids)])

 (defn generate-asteroid []
-    {
-        :x (rand width)
-        :y (rand height)
-        :xv (rand 10)
-        :yv (rand 10)
-        :a 0.0
-        :av (rand)
-        :radii (take 10 (repeatedly #(myrand 5 30)))
-    })
+    (let [a
+        {
+            :x (rand width)
+            :y (rand height)
+            :xv (rand 10)
+            :yv (rand 10)
+            :a 0.0
+            :av (rand)
+            :radii (take 10 (repeatedly #(myrand 5 30)))
+        }]
+    (assoc a
+        :poly (asteroid-shape (:radii a)))))

 (defn default-state [] {
     :time (now)


State.

State.

--- test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_030_refs.clj
+++ test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_030_refs.clj
@@ -59,7 +59,7 @@
 ;;;; How to choose between atoms and refs?
 ;;;;
 ;;;; - Me:
-;;;;   - Atoms are simpler and faster -- if they are good enough, use them
+;;;;   - Atoms are simpler -- if they are good enough, use them
 ;;;;
 ;;;; - From /Seven Concurrency Models in Seven Weeks/
 ;;;;   - Style & personal preference -- whatever seems clearest


Add button to unselect favorites

Add button to unselect favorites

--- frontend/src/cruncher/selections.cljs
+++ frontend/src/cruncher/selections.cljs
@@ -5,6 +5,27 @@
             [goog.dom :as gdom]
             [cruncher.utils.views :as vlib]
             [cruncher.utils.lib :as lib]))
+
+(defn unselect-favorites
+  "Unselect all favorites. Useful before crunching them."
+  []
+  (let [rows (gdom/getElementsByClass "poketable-row")]
+    (doall (map (fn [row]
+                  (let [id (.getAttribute row "data-id")
+                        favorite (lib/str->bool (.getAttribute row "data-favorite"))
+                        checkbox (gdom/getElement (str "poketable-checkbox-" id))]
+                    (when favorite (set! (.. checkbox -checked) false))))
+                rows))))
+
+(defn unselect-all
+  "Unselect all pokemon."
+  []
+  (let [rows (gdom/getElementsByClass "poketable-row")]
+    (doall (map (fn [row]
+                  (let [id (.getAttribute row "data-id")
+                        checkbox (gdom/getElement (str "poketable-checkbox-" id))]
+                    (set! (.. checkbox -checked) false)))
+                rows))))

 (defn mass-selections
   "Function for mass selections of pokemon depending on a predicate.
@@ -25,9 +46,6 @@

 (defn select-all-but-favorite []
   (mass-selections "data-favorite" "false"))
-
-(defn unselect-all []
-  (mass-selections "data-id" 0 not= false))

 (defn select-below-iv-threshold [percentage]
   (mass-selections "data-iv-perfect" percentage > true))
@@ -79,7 +97,8 @@
                       (dom/div #js {:className "col-md-6"}
                                (dom/label #js {:className "control-label"} "Clicking a button always overrides manual selections")
                                (dom/br nil)
-                               (vlib/button-default unselect-all "Unselect all")
+                               (vlib/button-default unselect-all "Unselect")
+                               (vlib/button-default unselect-favorites "Unselect Favorites")
                                (vlib/button-default select-all-but-favorite "Select all but favorite"))
                       (dom/div #js {:className "col-md-3"}
                                (dom/div nil (cp-threshold (om/props this))))


Change 'Auto-cancel builds' to 'Auto-cancel redundant builds'

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -554,7 +554,7 @@
             ;; TODO remove the LD flag once shipped
             (when (feature/enabled? :autocancel-builds)
               (describe-flag {:flag :autocancel-builds
-                              :title "Auto-cancel builds"
+                              :title "Auto-cancel redundant builds"
                               :blurb [:p
                                       "With the exception of your default branch, we will automatically cancel any queued or running builds on "
                                       "a branch when a newer build is triggered on that same branch. This feature will only apply to builds "


trace example now demonstrates returning raw trace data

--- src-docs/com/wsscode/pathom/book/tracing/demo.cljs
+++ src-docs/com/wsscode/pathom/book/tracing/demo.cljs
@@ -53,3 +53,26 @@
                   p/error-handler-plugin
                   p/request-cache-plugin
                   p/trace-plugin]}))
+
+; to get raw tracing results, include the :com.wsscode.pathom/trace key in your query
+(parser {} [:a :b
+            :com.wsscode.pathom/trace])
+
+;=>
+;{:com.wsscode.pathom/trace
+; {:start 0,
+;  :path [],
+;  :duration 5049,
+;  :details [{:event "process-pending",
+;             :duration 0,
+;             :start 1,
+;             :provides #{:com.wsscode.pathom/trace},
+;             :merge-result? false}
+;            {:event "flush-watchers-loop", :duration 0, :start 1}
+;            {:event "reset-loop",
+;             :duration 0,
+;             :start 1,
+;             :loop-keys [:com.wsscode.pathom/trace]}
+; ...
+
+


Remove unused server side

Remove unused server side

--- src/gol/server.clj
+++ src/gol/server.clj
@@ -1,37 +0,0 @@
-(ns gol.server
-  (:require [ring.middleware.file :refer [wrap-file]]
-            [ring.middleware.file-info :refer [wrap-file-info]]
-            [hiccup.page :refer [html5 include-js include-css]]
-            [hiccup.middleware :refer [wrap-base-url]]
-            [compojure.core :refer :all]
-            [compojure.route :as route]
-            [compojure.handler :as handler]
-            [ring.util.response :as response]))
-
-(defn index-page
-  [request]
-  (html5
-    [:head
-     (include-css
-       "//cdnjs.cloudflare.com/ajax/libs/normalize/3.0.0/normalize.min.css"
-       "/css/build/app/styles.css"
-       "/css/build/control/styles.css")]
-    [:body
-     [:div#app]
-     [:div#control]
-     (include-js
-       "//fb.me/react-0.9.0.js"
-       "/js/build/goog/base.js"
-       "/js/build/gol.js")
-     [:script
-      {:type "text/javascript"}
-      "goog.require('gol.client.main');"]]))
-
-(defroutes main-routes
-  (GET "/" [] index-page)
-  (route/resources "/")
-  (route/not-found "Page not found"))
-
-(def app
-  (-> (handler/site main-routes)
-      (wrap-base-url)))


js-emitter for first form

js-emitter for first form


Update core.clj

Update core.clj

--- src/ipython_clojure/core.clj
+++ src/ipython_clojure/core.clj
@@ -7,7 +7,7 @@
            [clj-time.format :as time-format]
            [com.keminglabs.zmq-async.core :refer [register-socket!]]
            [clojure.core.async :refer [sliding-buffer >! <! go chan close!]])
-  (:import [org.jeromq ZMQ])
+  (:import [org.zeromq ZMQ])
   (:gen-class :main true))

 (defn prep-config [args]


fix bug in multi-position

fix bug in multi-position

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -215,7 +215,7 @@
 (defn generate-multiposition-bursts [positions num-frames use-autofocus
                                      channels default-exposure triggers]
   (let [simple (generate-simple-burst-sequence
-                 num-frames use-autofocus channels triggers)]
+                 num-frames use-autofocus channels default-exposure triggers)]
     (flatten
       (for [pos-index (range (count positions))]
         (map #(assoc % :position-index pos-index


Futures over threads.

Futures over threads.

--- src/onyx/coordinator/async.clj
+++ src/onyx/coordinator/async.clj
@@ -168,14 +168,6 @@
       (tap ack-mult ack-ch-tail)
       (tap completion-mult completion-ch-tail)

-      (thread (born-peer-ch-loop log sync born-peer-ch-tail offer-ch-head dead-peer-ch-head))
-      (thread (dead-peer-ch-loop log dead-peer-ch-tail evict-ch-head))
-      (thread (planning-ch-loop log planning-ch-tail offer-ch-head))
-      (thread (ack-ch-loop log ack-ch-tail))
-      (thread (evict-ch-loop log sync evict-ch-tail offer-ch-head))
-      (thread (offer-ch-loop log sync offer-ch-tail ack-ch-head completion-ch-head evict-ch-head))
-      (thread (completion-ch-loop log sync queue completion-ch-tail offer-ch-head))
-
       (assoc component
         :planning-ch-head planning-ch-head
         :born-peer-ch-head born-peer-ch-head
@@ -191,18 +183,35 @@
         :evict-mult evict-mult
         :offer-mult offer-mult
         :ack-mult ack-mult
-        :completion-mult completion-mult)))
+        :completion-mult completion-mult
+
+        :born-peer-thread (future (born-peer-ch-loop log sync born-peer-ch-tail offer-ch-head dead-peer-ch-head))
+        :dead-peer-thread (future (dead-peer-ch-loop log dead-peer-ch-tail evict-ch-head))
+        :planning-thread (future (planning-ch-loop log planning-ch-tail offer-ch-head))
+        :ack-thread (future (ack-ch-loop log ack-ch-tail))
+        :evict-thread (future (evict-ch-loop log sync evict-ch-tail offer-ch-head))
+        :offer-thread (future (offer-ch-loop log sync offer-ch-tail ack-ch-head completion-ch-head evict-ch-head))
+        :completion-thread (future (completion-ch-loop log sync queue completion-ch-tail offer-ch-head)))))

   (stop [component]
     (prn "Stopping Coordinator")
-    (clojure.core.async/close! (:planning-ch-head component))
+
     (clojure.core.async/close! (:born-peer-ch-head component))
     (clojure.core.async/close! (:dead-peer-ch-head component))
+    (clojure.core.async/close! (:planning-ch-head component))
     (clojure.core.async/close! (:evict-ch-head component))
     (clojure.core.async/close! (:offer-ch-head component))
     (clojure.core.async/close! (:ack-ch-head component))
     (clojure.core.async/close! (:completion-ch-head component))

+    (future-cancel (:born-peer-thread component))
+    (future-cancel (:dead-peer-thread component))
+    (future-cancel (:planning-thread component))
+    (future-cancel (:evict-thread component))
+    (future-cancel (:offer-thread component))
+    (future-cancel (:ack-thread component))
+    (future-cancel (:completion-thread component))
+
     component))

 (defn coordinator []


Minor code cleanup.

Minor code cleanup.

--- src/open_company/api/entry.clj
+++ src/open_company/api/entry.clj
@@ -1,6 +1,6 @@
 (ns open-company.api.entry
   (:require [compojure.core :refer (defroutes GET OPTIONS)]
-            [liberator.core :refer (defresource by-method)]
+            [liberator.core :refer (defresource)]
             [open-company.api.common :as common]
             [open-company.resources.company :as company-res]
             [open-company.representations.common :as common-rep]
@@ -8,8 +8,6 @@
             [cheshire.core :as json]))

 ;; ----- Representations
-;; I assume these could go into a separate representations ns but since
-;; they're just links and not full domain objects I just kept them here

 (defn company-link [{:keys [name] :as c}]
   (common-rep/link-map "company" "GET" (company-rep/url c) company-rep/media-type :name name))
@@ -19,13 +17,13 @@
     user      (conj (common-rep/link-map "company-create" "POST" "/companies/" company-rep/media-type))
     companies (into (mapv company-link companies))))

-;; ----- Resources - see: http://clojure-liberator.github.io/liberator/assets/img/decision-graph.svg
-
-(defn handle-get [{:keys [user] :as _ctx}]
+(defn render-entry [{:keys [user] :as _ctx}]
   (let [companies (when user (company-res/get-companies-by-index "org-id" (:org-id user)))]
     (json/generate-string
       {:links (links user companies)}
       {:pretty true})))
+
+;; ----- Resources - see: http://clojure-liberator.github.io/liberator/assets/img/decision-graph.svg

 (defresource entry-point []
   common/anonymous-resource
@@ -41,7 +39,7 @@
   :handle-not-acceptable (fn [_] (common/only-accept 406 "application/json"))
   :handle-unsupported-media-type (fn [_] (common/only-accept 415 "application/json"))

-  :handle-ok handle-get
+  :handle-ok render-entry

   :handle-options (common/options-response [:options :get]))

@@ -49,4 +47,4 @@

 (defroutes entry-routes
   (OPTIONS "/" [] (entry-point))
-  (GET "/" [] (entry-point)))
+  (GET "/" [] (entry-point)))


Handle special case without .cljs.edn files

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -130,6 +130,8 @@
       (fn [fileset]
         (pod/with-call-in @pod
           (adzerk.boot-reload.server/set-options {:open-file ~open-file}))
+
+        ;; Only changed cljs.edn files
         (doseq [f (relevant-cljs-edn (b/fileset-diff @prev-pre fileset) ids)]
           (let [path     (tmp-path f)
                 spec     (-> f tmp-file slurp read-string)
@@ -137,6 +139,15 @@
                 out-file (io/file tmp path)]
             (write-cljs! tmp client-ns url ws-host (get spec :on-jsload on-jsload) asset-host)
             (add-init! client-ns spec out-file path)))
+
+        ;; Special case: boot-cljs used without .cljs.edn
+        ;; in that case we can just create client file with any name and it will be
+        ;; required by boot-cljs.
+        ;; If file already exists, do nothing.
+        (when (and (empty? (relevant-cljs-edn fileset ids))
+                   (nil? (b/tmp-get (.getPath (rutil/ns->file "adzerk.boot-reload" "cljs")))))
+          (write-cljs! tmp "adzerk.boot-reload" url ws-host on-jsload asset-host))
+
         (reset! prev-pre fileset)
         (let [fileset (-> fileset (add-resource tmp) commit!)
               fileset (try


Upload section

Upload section

--- src/airhead_cljs/core.cljs
+++ src/airhead_cljs/core.cljs
@@ -45,9 +45,9 @@
       [:div
        [:h2 "Playlist"]
        [:ul (for [track @playlist]
-             [:li
-              (dequeue-button track)
-              (track-span track)])]])))
+              [:li
+               (dequeue-button track)
+               (track-span track)])]])))

 (defn enqueue-button [track]
   [:input {:type "button" :value "Enqueue"
@@ -67,13 +67,15 @@
     (POST "/api/tracks" {:enc-type "multipart/form-data"
                          :body (js/FormData. form)})))

-(defn upload-form []
-  [:form {:id "upload-form"}
-   [:input {:type "file"
-            :name "track"}]
-   [:input {:type "button"
-            :value "Upload"
-            :on-click post-track}]])
+(defn upload-section []
+  [:div
+   [:h2 "Upload"]
+   [:form {:id "upload-form"}
+    [:input {:type "file"
+             :name "track"}]
+    [:input {:type "button"
+             :value "Upload"
+             :on-click post-track}]]])

 (defn tracks-section []
   (let [tracks (atom [])
@@ -92,8 +94,7 @@
        [:input {:type "text"
                 :value @query
                 :on-change reset-query}]
-       [tracks-list tracks]
-       [upload-form]])))
+       [tracks-list tracks]])))

 (defn home-page []
   (let [info (atom {})]
@@ -104,6 +105,7 @@
        [:p  (@info "greet_message")]
        [stream-section (@info "stream_url")]
        [current-track-section]
+       [upload-section]
        [playlist-section]
        [tracks-section]])))


Refactor distance computation

Refactor distance computation

--- src/rdf_path_examples/examples.clj
+++ src/rdf_path_examples/examples.clj
@@ -143,6 +143,17 @@
                      (comp distance-fn vals)))
          (into {}))))

+(defn compute-distances
+  "Compute distances between `examples` navigating via `path-map` and using `path-data`
+  with data about path nodes."
+  [^Model examples
+   path-map
+   ^Model path-data]
+  (let [path-json-ld (json-ld/expand-model path-data)
+        resolve-fn (partial find-by-iri path-json-ld)
+        datatype-property-ranges (extract-datatype-property-ranges path-data)]
+    (path-distances path-map resolve-fn datatype-property-ranges)))
+
 (defn describe-paths
   "Retrieve representations of paths identified by `path-iris` from `data`."
   [^Model data
@@ -184,10 +195,7 @@
   (let [examples (retrieve-sample-examples params path)
         path-map (extract-examples examples)
         path-data (retrieve-path-data (extract-path-nodes examples) params)
-        path-json-ld (json-ld/expand-model path-data)
-        resolve-fn (partial find-by-iri path-json-ld)
-        datatype-property-ranges (extract-datatype-property-ranges path-data)
-        distances (path-distances path-map resolve-fn datatype-property-ranges)
+        distances (compute-distances examples path-map path-data)
         chosen-path-iris (vec (greedy-construction (set (keys path-map)) distances limit))
         chosen-paths (retrieve-chosen-paths (.union examples path-data) chosen-path-iris)]
     (serialize-examples chosen-paths)))


iff-refl ok

iff-refl ok


layout

layout

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -86,8 +86,7 @@
         (debug (<<  "Associating existing ip ~{ip} to ~{instance-id}"))
         (assoc-pub-ip endpoint instance-id ip))
       (update-ip spec endpoint instance-id)
-      (wait-for-ssh (pub-dns endpoint instance-id) user [5 :minute])
-      ))
+      (wait-for-ssh (pub-dns endpoint instance-id) user [5 :minute])))

   (delete [this]
     (with-instance-id


~(defn write-lexicon): wrap body in a (korma.db/transaction)

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -10,7 +10,8 @@
     [clojure.tools.logging :as log]
     [clojure.tools.namespace.repl :refer [refresh refresh-all]]
     [dag_unify.core :refer [fail? get-in remove-top-values strip-refs serialize unify ref?]]
-    [korma.core :refer [exec-raw]]))
+    [korma.core :refer [exec-raw]]
+    [korma.db :refer [transaction]]))

 ;; TODO: more fine-grained approach to dealing with exceptions:
 ;; should be sensitive to environment -
@@ -467,17 +468,20 @@
 ;; (babel.writer/write-lexicon "en" lexicon)
 (defn write-lexicon [language lexicon]
   (babel.korma/init-db)
-  (truncate-lexicon language)
-  (let [canonicals (sort (keys lexicon))]
-    (loop [remain canonicals
-           result 0]
-      (let [[canonical & remaining] remain]
-        (log/debug (str "(write-lexicon " language ":" canonical ")"))
-        (insert-lexeme canonical (get lexicon canonical) language)
-        (if (empty? remaining)
-          (+ 1 result)
-          (recur remaining
-                 (+ 1 result)))))))
+
+  (transaction
+   (truncate-lexicon language)
+
+   (let [canonicals (sort (keys lexicon))]
+     (loop [remain canonicals
+            result 0]
+       (let [[canonical & remaining] remain]
+         (log/debug (str "(write-lexicon " language ":" canonical ")"))
+         (insert-lexeme canonical (get lexicon canonical) language)
+         (if (empty? remaining)
+           (+ 1 result)
+           (recur remaining
+                  (+ 1 result))))))))

 ;; TODO: more documentation for the command language that (defn process) understands.
 ;; TODO: Every unit contains the entire language model: should instead pass a name


Make buffer fns that modify data in place bang! fns

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -84,28 +84,35 @@
               (recur (inc idx) (next samps))))
           (recur (+ recvd blen)))))))

-(defn buffer-write
-  "Write into a section of an audio buffer."
+(defn buffer-write!
+  "Write into a section of an audio buffer.
+   Modifies the buffer in place on the server."
   [buf start len data]
   (assert (buffer? buf))
+
   (apply snd "/b_setn" (:id buf) start len (map double data)))

-(defn buffer-fill
-  "Fill a buffer range with a single value."
+(defn buffer-fill!
+  "Fill a buffer range with a single value.
+   Modifies the buffer in place on the server."
   [buf start len val]
   (assert (buffer? buf))
+
   (snd "/b_fill" (:id buf) start len (double val)))

-(defn buffer-set
-  "Write a single value into a buffer."
+(defn buffer-set!
+  "Write a single value into a buffer.
+  Modifies the buffer in place on the server."
   [buf index val]
   (assert (buffer? buf))
+
   (snd "/b_set" (:id buf) index (double val)))

 (defn buffer-get
   "Read a single value from a buffer."
   [buf index]
   (assert (buffer? buf))
+
   (let [res (recv "/b_set")]
     (snd "/b_get" (:id buf) index)
     (last (:args (await-promise! res)))))
@@ -114,6 +121,7 @@
   "Save the float audio data in an audio buffer to a wav file."
   [buf path & args]
   (assert (buffer? buf))
+
   (let [arg-map (merge (apply hash-map args)
                        {:header "wav"
                         :samples "float"
@@ -121,6 +129,7 @@
                         :start-frame 0
                         :leave-open 0})
         {:keys [header samples n-frames start-frame leave-open]} arg-map]
+
     (snd "/b_write" (:id buf) path header samples
          n-frames start-frame
          (if leave-open 1 0))