Unify XCC/XDM conversion into types lookup table

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -1,7 +1,7 @@
 (ns uruk.core
   "Marklogic XCC core functions: session management, querying, type
   conversion, transactions."
-  (:require [clojure.set]
+  (:require clojure.set
             [clojure.data.json :as json]
             [clojure.data.xml :as xml]
             [slingshot.slingshot :as sling])
@@ -90,62 +90,294 @@
   (hash-map (.toString (.getName xdm-var))
             (.toString (.getValue xdm-var))))

-(def xcc-type->conv-fn
-  "Default mapping from MarkLogic XCC types (e.g. those that might be
-  returned in a query's result set) to Clojure functions intended to
-  convert to Clojure types. See
-  https://docs.marklogic.com/javadoc/xcc/com/marklogic/xcc/types/package-summary.html"
-  {"array-node()" java-json->clj-json ;; ArrayNode
-   "boolean-node()" #(.asBoolean %)  ;; BooleanNode
-
-   "cts:box" #(.asString %) ;; would be nice to convert box to seq of 4 numbers, unless that is disrupted by other element types
-   "cts:circle" #(.asString %)
-   "cts:point" #(.asString %)
-   "cts:polygon" #(.asString %)
-
-   "json:array" java-json->clj-json ;; JSArray
-   "json:object" java-json->clj-json ;; JSObject
-
-   ;; JsonItem TODO
-   "null-node()" java-json->clj-json ;; NullNode
-   "number-node()" java->num ;; NumberNode
-   "object-node()" java-json->clj-json ;; ObjectNode
-
-   ;; XdmAtomic TODO
-   "attribute()" #(.asString %) ;; XdmAttribute
-   "binary()" #(.asBinaryData %) ;; XdmBinary
-   "comment()" #(.asString %) ;; XdmComment
-   "document-node()" #(.asString %) ;; XdmDocument
-   "duration()" #(.toString %) ;; XdmDuration XXX may only ever come through as xs:duration
-   "element()" #(.asString %) ;; XdmElement
-   ;; XdmItem TODO
-   "text()" #(.asString %) ;; XdmText
-   "variable()" xdm-var->str ;; XdmVariable -- XXX unknown if the key used matches getValueType
-
-   "xs:anyURI" str
-   "xs:base64Binary" #(.asBinaryData %) ;; XSBase64Binary
-   "xs:boolean" #(.asPrimitiveBoolean %)
-   "xs:date" str
-   "xs:dateTime" str
-   "xs:dayTimeDuration" str
-   "xs:decimal" java->num
-   "xs:double" java->num
-   "xs:duration" str
-   "xs:float" java->num
-   ;; Maybe strip hyphens from all Gregorian date-parts?
-   ;; or make conform to a particular date type?
-   "xs:gDay" str
-   "xs:gMonth" str
-   "xs:gMonthDay" str
-   "xs:gYear" str
-   "xs:gYearMonth" str
-   "xs:hexBinary" str ;; looks OK but test with real doc
-   "xs:integer" java->num
-   "xs:QName" str
-   "xs:string" str
-   "xs:time" str
-   "xs:untypedAtomic" str ;; NB: also referred to as "xdt:untypedAtomic" in type listing
-   "xs:yearMonthDuration" str})
+(defn ->xml-str
+  "Assumes that its input is valid XML in some format, returning that
+  XML in its String representation. Accepts String, hiccup-style
+  vectors, and clojure.data.xml.Element."
+  [xml]
+  (cond
+    (string? xml) xml
+    (vector? xml) (xml/emit-str (xml/sexp-as-element xml))
+    (instance? clojure.data.xml.Element xml) (xml/emit-str xml)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; XCC type table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def xcc-types
+  "Lookup table for XCC type information.
+
+  Includes all Clojure-relevant info about XCC types (and XML schema
+  types relevant to MarkLogic XCC). Provides functions for conversion
+  to and from XCC types and XdmVariable-suitable objects from Clojure.
+
+  Values are keyed by keyword describing the XCC type. Each value is
+  organized as follows:
+
+  `:ml->clj` maps to the function used to convert from MarkLogic to
+  Clojure
+
+  `:clj->xdm` maps to the function used to convert from Clojure to a
+  value appropriate for use in an XDM variable
+
+  `:xml-name` maps to the string used to refer to this type in
+  XQuery (its XML schema name)
+
+  `:xcc-type` maps to the corresponding
+  com.marklogic.xcc.types.ValueType field"
+  {:attribute {;; FIXME Causes "Unhandled java.lang.InternalError | Unrecognized valueType: attribute()" if passed as variable :type
+               :ml->clj #(.asString %)
+               :clj->xdm identity ;; doesn't seem to be implemented by ValueFactory: "java.lang.InternalError Unrecognized valueType: attribute()"
+               :xml-name "attribute()"
+               :xcc-type ValueType/ATTRIBUTE}
+   :binary {:ml->clj #(.asBinaryData %)
+            :clj->xdm identity ;; TODO
+            :xml-name "binary()"
+            :xcc-type ValueType/BINARY}
+
+   :array-node {:ml->clj java-json->clj-json
+                :clj->xdm #(ValueFactory/newArrayNode (json/write-str %))
+                :xml-name "array-node()"
+                :xcc-type ValueType/ARRAY_NODE}
+   :boolean-node {:ml->clj #(.asBoolean %)
+                  :clj->xdm #(-> (com.fasterxml.jackson.databind.node.JsonNodeFactory/instance)
+                                 (.booleanNode %)
+                                 ValueFactory/newBooleanNode)
+                  :xml-name "boolean-node()"
+                  :xcc-type ValueType/BOOLEAN_NODE}
+   :comment {:ml->clj #(.asString %)
+             :clj->xdm identity ;; TODO, also really :comment-node
+             :xml-name "comment()"
+             :xcc-type ValueType/COMMENT} ;; FIXME if passed as variable :type, causes: com.marklogic.xcc.exceptions.XQueryException: XDMP-LEXVAL: xs:QName("comment()") -- Invalid lexical value "comment()"
+
+   :cts-box {:ml->clj #(.asString %) ;; would be nice to convert box to seq of 4 numbers, unless that is disrupted by other element types
+             :clj->xdm str
+             :xml-name "cts:box"
+             :xcc-type ValueType/CTS_BOX}
+   :cts-circle {:ml->clj #(.asString %)
+                :clj->xdm #(let [[radius [latitude longitude]] %]
+                             (.asString (ValueFactory/newCtsCircle
+                                         (str radius)
+                                         (ValueFactory/newCtsPoint (str latitude)
+                                                                   (str longitude)))))
+                :xml-name "cts:circle"
+                :xcc-type ValueType/CTS_CIRCLE}
+   :cts-point {:ml->clj #(.asString %)
+               :clj->xdm #(str (first %) ","
+                               (second %)) ;; Expects a 2-number sequence
+               :xml-name "cts:point"
+               :xcc-type ValueType/CTS_POINT}
+   :cts-polygon {:ml->clj #(.asString %)
+                 :clj->xdm #(let [vertices %]
+                              ;; Expects a sequence of 2-element sequences, each
+                              ;; describing successive vertices (points) of the
+                              ;; polygon
+                              (.asString (ValueFactory/newCtsPolygon
+                                          (mapv (fn [latitude longitude]
+                                                  (ValueFactory/newCtsPoint (str latitude)
+                                                                            (str longitude)))
+                                                vertices))))
+                 :xml-name "cts:polygon"
+                 :xcc-type ValueType/CTS_POLYGON}
+
+   :document {:ml->clj #(.asString %) ;; XdmDocument
+              :clj->xdm ->xml-str
+              :xml-name "document-node()" ;; XXX key should be :document-node, really
+              :xcc-type ValueType/DOCUMENT}
+   :element {:ml->clj  #(.asString %)
+             :clj->xdm ->xml-str
+             :xml-name "element()"
+             :xcc-type ValueType/ELEMENT}
+
+   :js-array {:ml->clj java-json->clj-json
+              :clj->xdm #(ValueFactory/newJSArray (json/write-str %))
+              :xml-name "json:array"
+              :xcc-type ValueType/JS_ARRAY}
+   :js-object {:ml->clj java-json->clj-json
+               :clj->xdm #(ValueFactory/newJSObject (json/write-str %))
+               :xml-name "json:object"
+               :xcc-type ValueType/JS_OBJECT}
+
+   :node {:ml->clj str
+          :clj->xdm identity
+          :xml-name nil ;; TODO XXX ???
+          :xcc-type ValueType/NODE}
+   :null-node {:ml->clj java-json->clj-json
+               :clj->xdm nil
+               :xml-name "null-node()"
+               :xcc-type ValueType/NULL_NODE}
+   :number-node {:ml->clj java->num
+                 :clj->xdm str
+                 :xml-name "number-node()"
+                 :xcc-type ValueType/NUMBER_NODE}
+   :object-node {:ml->clj java-json->clj-json
+                 :clj->xdm #(ValueFactory/newObjectNode (json/write-str %))
+                 :xml-name "object-node()"
+                 :xcc-type ValueType/OBJECT_NODE}
+
+   :processing-instruction {:ml->clj str
+                            :clj->xdm str ;; TODO test?
+                            :xml-name nil ;; XXX ???
+                            :xcc-type ValueType/PROCESSING_INSTRUCTION}
+   :sequence {:ml->clj str
+              :clj->xdm identity ;; XXX WONTFIX -- see GitHub issue #8: "com.marklogic.xcc.exceptions.UnimplementedFeatureException - Setting variables that are sequences is not supported"
+              :xml-name nil ;; XXX ???
+              :xcc-type ValueType/SEQUENCE}
+   :text {;; FIXME causes XDMP-LEXVAL
+          :ml->clj #(.asString %)
+          :clj->xdm identity  ;; TODO, also really :text-node
+          :xml-name "text()"
+          :xcc-type ValueType/TEXT}
+   :variable {;; XdmVariable. Unknown if the key used matches getValueType.
+              :ml->clj xdm-var->str
+              :clj->xdm identity  ;; FIXME
+              :xml-name "variable()"
+              ;; FIXME
+              :xcc-type nil}
+
+   :xs-any-uri {:ml->clj str
+                :clj->xdm identity ;; TODO
+                :xml-name "xs:anyURI"
+                :xcc-type ValueType/XS_ANY_URI}
+   :xs-base64-binary {:ml->clj #(.asBinaryData %)
+                      :clj->xdm identity ;; TODO
+                      :xml-name "xs:base64Binary"
+                      :xcc-type ValueType/XS_BASE64_BINARY}
+   :xs-boolean {:ml->clj #(.asPrimitiveBoolean %)
+                :clj->xdm identity
+                :xml-name "xs:boolean"
+                :xcc-type ValueType/XS_BOOLEAN}
+
+   :xs-time {:ml->clj str
+             :clj->xdm identity ;; TODO
+             :xml-name "xs:time"
+             :xcc-type ValueType/XS_TIME}
+   :xs-date {:ml->clj str
+             :clj->xdm identity ;; TODO
+             :xml-name "xs:date"
+             :xcc-type ValueType/XS_DATE}
+   :xs-date-time {:ml->clj str
+                  :clj->xdm identity ;; TODO
+                  :xml-name "xs:dateTime"
+                  :xcc-type ValueType/XS_DATE_TIME}
+
+   ;; Numbers
+   :xs-integer {:ml->clj java->num
+                :clj->xdm identity
+                :xml-name "xs:integer"
+                :xcc-type ValueType/XS_INTEGER}
+   :xs-decimal {:ml->clj java->num
+                :clj->xdm identity
+                :xml-name "xs:decimal"
+                :xcc-type ValueType/XS_DECIMAL}
+   :xs-double {:ml->clj java->num
+               :clj->xdm identity
+               :xml-name "xs:double"
+               :xcc-type ValueType/XS_DOUBLE}
+   :xs-float {:ml->clj java->num
+              :clj->xdm identity
+              :xml-name "xs:float"
+              :xcc-type ValueType/XS_FLOAT}
+
+   ;; Durations
+   :duration {;; XdmDuration should only ever come through as
+              ;; xs:duration; this is a purely Java construct.
+              :ml->clj #(.toString %)
+              :clj->xdm identity ;; TODO test
+              :xml-name "duration()"
+              :xcc-type nil}
+   :xs-duration {:ml->clj str
+                 :clj->xdm identity
+                 :xml-name "xs:duration"
+                 :xcc-type ValueType/XS_DURATION}
+   :xs-day-time-duration {:ml->clj str
+                          :clj->xdm identity ;; TODO
+                          :xml-name "xs:dayTimeDuration"
+                          ;; UML diagram says "XDT_DAY_TIME_DURATION" but that doesn't resolve
+                          :xcc-type ValueType/XS_DAY_TIME_DURATION}
+   :xs-year-month-duration {:ml->clj str
+                            :clj->xdm identity ;; TODO
+                            :xml-name "xs:yearMonthDuration"
+                            ;; UML diagram says "XDT_YEAR_MONTH_DURATION" but that doesn't resolve
+                            :xcc-type ValueType/XS_YEAR_MONTH_DURATION}
+
+   ;; Gregorian dates/times
+   :xs-gday {:ml->clj str
+             :clj->xdm identity ;; TODO
+             :xml-name "xs:gDay"
+             :xcc-type ValueType/XS_GDAY}
+   :xs-gmonth {:ml->clj str
+               :clj->xdm identity ;; TODO
+               :xml-name "xs:gMonth"
+               :xcc-type ValueType/XS_GMONTH}
+   :xs-gmonth-day {:ml->clj str
+                   :clj->xdm identity ;; TODO
+                   :xml-name "xs:gMonthDay"
+                   :xcc-type ValueType/XS_GMONTH_DAY}
+   :xs-gyear {:ml->clj str
+              :clj->xdm identity ;; TODO
+              :xml-name "xs:gYear"
+              :xcc-type ValueType/XS_GYEAR}
+   :xs-gyear-month {:ml->clj str
+                    :clj->xdm identity ;; TODO
+                    :xml-name "xs:gYearMonth"
+                    :xcc-type ValueType/XS_GYEAR_MONTH}
+
+   :xs-hex-binary {:ml->clj str ;; looks OK but needs to be tested with real doc
+                   :clj->xdm identity ;; TODO
+                   :xml-name "xs:hexBinary"
+                   :xcc-type ValueType/XS_HEX_BINARY}
+   :xs-qname {:ml->clj str
+              :clj->xdm identity ;; TODO
+              :xml-name "xs:QName"
+              :xcc-type ValueType/XS_QNAME}
+   :xs-string {:ml->clj str
+               :clj->xdm str
+               :xml-name "xs:string"
+               :xcc-type ValueType/XS_STRING}
+   :xs-untyped-atomic {:ml->clj str
+                       :clj->xdm identity ;; TODO
+                       ;; NB: also referred to as "xdt:untypedAtomic" in type listing
+                       :xml-name "xs:untypedAtomic"
+                       ;; UML diagram says "XDT_UNTYPED_ATOMIC" but that doesn't resolve
+                       :xcc-type ValueType/XS_UNTYPED_ATOMIC}
+
+   ;; Default:
+   nil {:ml->clj str
+        :clj->xdm identity ;; TODO
+        :xml-name nil
+        :xcc-type ValueType/XS_STRING}})
+
+(def xml-type-str->conv-fn
+  "Default mapping from XML Schema type strings to Clojure functions
+  that will convert such a value to Clojure types.
+
+  See https://docs.marklogic.com/javadoc/xcc/com/marklogic/xcc/types/package-summary.html"
+  (reduce (fn [acc [k {:keys [xml-name ml->clj]}]]
+            (assoc acc xml-name ml->clj))
+          {}
+          xcc-types))
+
+(def variable-types
+  "Mapping between Clojure keywords describing XML Schema types types
+  and the Java representations of those types.
+
+  See https://docs.marklogic.com/javadoc/xcc/com/marklogic/xcc/types/ValueType.html"
+  (reduce (fn [acc [k {:keys [xcc-type]}]]
+            (assoc acc k xcc-type))
+          {}
+          xcc-types))
+
+(def xcc-type->xdm-conv-fn
+  "Mapping from Clojure keywords describing XCC types to functions
+  that will convert a Clojure value to an object appropriate for use
+  in a MarkLogic XdmVariable."
+  (reduce (fn [acc [k {:keys [clj->xdm]}]]
+            (assoc acc k clj->xdm))
+          {}
+          xcc-types))
+
+;;;;

 (defn result->type
   "Returns type string of the given query Result object. Currently
@@ -158,10 +390,10 @@
   MarkLogic query result sequence. Default type mappings can be
   overridden (in part or in whole) with the optional parameter
   `type-mapping`, which should contain a transformation function keyed
-  by an XCC type string. See `xcc-type->conv-fn` above."
+  by an XCC type string. See `xml-type-str->conv-fn` above."
   [result-sequence & [type-mapping]]
   ;; TODO throw informative exception if type not found in types
-  (map (fn [item] (((merge xcc-type->conv-fn
+  (map (fn [item] (((merge xml-type-str->conv-fn
                           (when (map? type-mapping)
                             type-mapping))
                    (.toString (.getValueType item))) item))
@@ -490,138 +722,6 @@
                  server-response))
     server-response))

-(def variable-types
-  "Mapping between Clojure keywords describing XDM Variable types and
-  the Java representations of those types."
-  {:array-node ValueType/ARRAY_NODE
-   :attribute ValueType/ATTRIBUTE ;; FIXME Causes "Unhandled java.lang.InternalError | Unrecognized valueType: attribute()" if passed as variable :type
-   :binary ValueType/BINARY
-   :boolean-node ValueType/BOOLEAN_NODE
-   :comment ValueType/COMMENT ;; FIXME if passed as variable :type, causes: com.marklogic.xcc.exceptions.XQueryException: XDMP-LEXVAL: xs:QName("comment()") -- Invalid lexical value "comment()"
-   :cts-box ValueType/CTS_BOX
-   :cts-circle ValueType/CTS_CIRCLE
-   :cts-point ValueType/CTS_POINT
-   :cts-polygon ValueType/CTS_POLYGON
-
-   :document ValueType/DOCUMENT ;; XXX document-node, really
-   :element ValueType/ELEMENT
-   :js-array ValueType/JS_ARRAY
-   :js-object ValueType/JS_OBJECT
-   :node ValueType/NODE
-   :null-node ValueType/NULL_NODE
-   :number-node ValueType/NUMBER_NODE
-   :object-node ValueType/OBJECT_NODE
-   :processing-instruction ValueType/PROCESSING_INSTRUCTION
-   :sequence ValueType/SEQUENCE
-   :text ValueType/TEXT ;; FIXME causes XDMP-LEXVAL
-
-   :xs-any-uri ValueType/XS_ANY_URI
-   :xs-base64-binary ValueType/XS_BASE64_BINARY
-   :xs-boolean ValueType/XS_BOOLEAN
-   :xs-date ValueType/XS_DATE
-   :xs-date-time ValueType/XS_DATE_TIME
-   :xs-day-time-duration ValueType/XS_DAY_TIME_DURATION
-   :xs-decimal ValueType/XS_DECIMAL
-   :xs-double ValueType/XS_DOUBLE
-   :xs-duration ValueType/XS_DURATION
-   :xs-float ValueType/XS_FLOAT
-
-   :xs-gday ValueType/XS_GDAY
-   :xs-gmonth ValueType/XS_GMONTH
-   :xs-gmonth-day ValueType/XS_GMONTH_DAY
-   :xs-gyear ValueType/XS_GYEAR
-   :xs-gyear-month ValueType/XS_GYEAR_MONTH
-
-   :xs-hex-binary ValueType/XS_HEX_BINARY
-   :xs-integer ValueType/XS_INTEGER
-   :xs-qname ValueType/XS_QNAME
-   :xs-string ValueType/XS_STRING
-   :xs-time ValueType/XS_TIME
-   :xs-untyped-atomic ValueType/XS_UNTYPED_ATOMIC
-   :xs-year-month-duration ValueType/XS_YEAR_MONTH_DURATION
-
-   ;; default:
-   nil ValueType/XS_STRING})
-
-(defn ->xml-str
-  "Assumes that its input is valid XML in some format, returning that
-  XML in its String representation. Accepts String, hiccup-style
-  vectors, and clojure.data.xml.Element."
-  [xml]
-  (cond
-    (string? xml) xml
-    (vector? xml) (xml/emit-str (xml/sexp-as-element xml))
-    (instance? clojure.data.xml.Element xml) (xml/emit-str xml)))
-
-(defn wrap-val
-  "Given a Clojure value, returns a value in a type appropriate for a
-  MarkLogic XdmVariable."
-  [clj-val type]
-  (case type
-    :array-node (ValueFactory/newArrayNode (json/write-str clj-val))
-    :boolean-node (-> (com.fasterxml.jackson.databind.node.JsonNodeFactory/instance)
-                      (.booleanNode clj-val)
-                      ValueFactory/newBooleanNode)
-    :attribute clj-val ;; doesn't seem to be implemented by ValueFactory: "java.lang.InternalError Unrecognized valueType: attribute()"
-    :binary clj-val ;; TODO
-    :comment clj-val ;; TODO, also really :comment-node
-
-    :cts-box (str clj-val) ;; 4-element sequence or String
-    :cts-circle (let [[radius [latitude longitude]] clj-val]
-                  (.asString (ValueFactory/newCtsCircle (str radius)
-                                                        (ValueFactory/newCtsPoint (str latitude)
-                                                                                (str longitude)))))
-    :cts-point (str (first clj-val) ","
-                    (second clj-val)) ;; Expects a 2-number sequence
-    :cts-polygon (let [vertices clj-val]
-                   ;; Expects a sequence of 2-element sequences, each
-                   ;; describing successive vertices (points) of the
-                   ;; polygon
-                   (.asString (ValueFactory/newCtsPolygon
-                               (mapv (fn [latitude longitude]
-                                       (ValueFactory/newCtsPoint (str latitude)
-                                                                 (str longitude)))
-                                     vertices))))
-
-    :document (->xml-str clj-val) ;; :document-node, really, but we're following ValueType
-    :element (->xml-str clj-val)
-    :js-array (ValueFactory/newJSArray (json/write-str clj-val))
-    :js-object (ValueFactory/newJSObject (json/write-str clj-val))
-    :node clj-val
-    :null-node nil
-    :number-node (str clj-val)
-    :object-node (ValueFactory/newObjectNode (json/write-str clj-val))
-    :processing-instruction clj-val ;; TODO
-    :sequence clj-val ;; XXX WONTFIX -- see GitHub issue #8: "com.marklogic.xcc.exceptions.UnimplementedFeatureException - Setting variables that are sequences is not supported"
-    :text clj-val ;; TODO, also really :text-node
-
-    :xs-any-uri clj-val ;; TODO
-    :xs-base64-binary clj-val ;; TODO
-    :xs-boolean clj-val
-    :xs-date clj-val ;; TODO
-    :xs-date-time clj-val ;; TODO
-    :xs-day-time-duration clj-val ;; TODO
-    :xs-decimal clj-val
-    :xs-double clj-val
-    :xs-duration clj-val
-    :xs-float clj-val
-
-    :xs-gday clj-val ;; TODO
-    :xs-gmonth clj-val ;; TODO
-    :xs-gmonth-day clj-val ;; TODO
-    :xs-gyear clj-val ;; TODO
-    :xs-gyear-month clj-val ;; TODO
-
-    :xs-hex-binary clj-val ;; TODO
-    :xs-integer clj-val
-    :xs-qname clj-val ;; TODO
-    :xs-string (str clj-val)
-    :xs-time clj-val ;; TODO
-    :xs-untyped-atomic clj-val ;; TODO
-    :xs-year-month-duration clj-val ;; TODO
-
-    clj-val))
-
 (defn- make-request-obj
   "Build a Request object using the given `request-factory` builder,
   request `options`, and bindings for XQuery external `variables`."
@@ -636,12 +736,12 @@
                                       (variable-types type)
                                       (if as-is?
                                         value
-                                        (wrap-val value type)))
+                                        ((xcc-type->xdm-conv-fn type) value)))
                      (.setNewVariable acc (name vname)
                                       (variable-types type)
                                       (if as-is?
                                         value
-                                        (wrap-val value type))))))
+                                        ((xcc-type->xdm-conv-fn type) value))))))
                acc)
              (doto request-factory (.setOptions (make-request-options options)))
              variables))
@@ -651,8 +751,8 @@
   `session` using `request-factory` and `query`. Modify it
   with (possibly empty) `options` and `variables` maps. Applies type
   conversion to response according to defaults and
-  `xcc-type->conv-fn`. Variables may be passed as a map of Strings or
-  with String names corresponding to maps describing the variable
+  `xml-type-str->conv-fn`. Variables may be passed as a map of Strings
+  or with String names corresponding to maps describing the variable
   using mandatory key `:value` and optional keys `:namespace` and
   `:type`.`"
   [request-factory session query options variables types shape]
@@ -694,7 +794,7 @@
   connection defined by the given session. Takes an optional
   configuration map describing request `options` and `variables`,
   desired `shape` of the result, and overrides of default type
-  conversion in `xcc-type->conv-fn`.
+  conversion in `xml-type-str->conv-fn`.

   Options passed must be in `valid-request-options` and conform to
   `request-options`.
@@ -708,8 +808,9 @@
   return only the first value.

   Type conversion overrides must be a map using keys present in
-  `uruk.core/xcc-type->conv-fn` and conform to use in `convert-types`,
-  that is, including values which are a function of one variable."
+  `uruk.core/xml-type-str->conv-fn` and conform to use in
+  `convert-types`, that is, including values which are a function of
+  one variable."
   ([session query]
    (execute-xquery session query {}))
   ([session query {:keys [options variables types shape]}]
@@ -721,7 +822,7 @@
   defined by the given session. Takes an optional configuration map
   describing request `options` and `variables`, desired `shape` of the
   result, and overrides of default type conversion in
-  `xcc-type->conv-fn`.
+  `xml-type-str->conv-fn`.

   Options passed must be in `valid-request-options` and conform to
   `request-options`.
@@ -735,8 +836,9 @@
   return only the first value.

   Type conversion overrides must be a map using keys present in
-  `uruk.core/xcc-type->conv-fn` and conform to use in `convert-types`,
-  that is, including values which are a function of one variable."
+  `uruk.core/xml-type-str->conv-fn` and conform to use in
+  `convert-types`, that is, including values which are a function of
+  one variable."
   ([session module]
    (execute-module session module {}))
   ([session module {:keys [options variables types shape]}]


gui checkpoint

gui checkpoint

--- src/wines/gui.clj
+++ src/wines/gui.clj
@@ -1,20 +1,70 @@
 (ns wines.gui
   (:require [seesaw.dev :as dev]
             [seesaw.core :as ss]
-            [wines.util :refer [parse-json]]))
+            [wines.util :refer [parse-json]]
+            [clojure.pprint :refer [pprint]]))

 (defn call-ui []
   (println "Calling ui soon!")
   nil)

 (def bg-color "#fdfdfd")
-
 (def max-height 530)
 (def app-height 600)
+(def wine-results-size [370 :by max-height])
+(def wine-properties-size [400 :by (- max-height 30)])
+(def main-search-size [210 :by max-height])

 (ss/native!)

+
+;;;; TODO: development, mocking. remove!
+(def mocked-body
+  (take 35
+    (cycle
+      (:List
+        (:Products
+          (parse-json
+            (slurp (clojure.java.io/resource "body.seed.json")) "testing"))))))
+
+(def results-model
+  (for [product mocked-body]
+    (let [simpler-product (select-keys product [:Name :Id])]
+      (clojure.string/join
+        " "
+        [(format "%-8d" (:Id simpler-product))
+         (:Name simpler-product)]
+        ))))
+
+;;;;;
+
+
+;; todo: prompt user for api key?
+
+; TODO: why menubar wont show?
+(def main-menu
+  (ss/menubar
+    :items [(ss/menu
+              :text "File"
+              :items [(ss/action
+                        :name "Open..."
+                        :key "menu O"
+                        :handler (fn [e] (println "Open something")))])
+            (ss/menu
+              :text "Edit"
+              :items [(ss/action
+                        :name "Undo"
+                        :key "menu Z"
+                        :handler (fn [e] (println "Undo something")))])
+            (ss/menu
+              :text "Help"
+              :items [(ss/action
+                        :name "About"
+                        :key "menu H"
+                        :handler (fn [e] (println "Show about dialog")))])]))
+
 (def window (ss/frame :title "Wine Finder",
+                      :menubar main-menu
 ;;            :on-close :exit,    ; add this when done...?
 ;;                       :resizable? false  ; todo: resizable false
                       :size [950 :by app-height]
@@ -23,8 +73,6 @@
 (defn display [content]
   (ss/config! window :content content)   ; config! used to configuer frame, lbls etc
   content)
-
-(def tool-bar (ss/toolbar :items ["File" "About"]))

 (def title-lbl (ss/label "Catalog Search"))

@@ -38,7 +86,7 @@
    :icon "http://cache.wine.com/images/logos/80x80_winecom_logo.png"))

 (def search-input
-  (ss/text ; could replace with ss/input
+  (ss/text ; could replace with ss/input later
    :text "Cabernet Sauvignon"
    :editable? true
    :columns 14))
@@ -66,58 +114,56 @@
    :class :label-input))

-(def mocked-body
-  (reduce
-    into
-    (replicate
-      5
-      (:List
-        (:Products
-          (parse-json (slurp (clojure.java.io/resource "body.seed.json")) "w.e"))))))
-
-
-
-;; (prn (:Name (first mocked-body)))
-
-(def results-model (for [product mocked-body]
-  [(:Name (select-keys product [:Name]))]))
-
-
-
-(def results (ss/scrollable (ss/listbox :model results-model
+(def wine-results (ss/scrollable (ss/listbox :model results-model
                          :id :results
-                         :border [2 "Results" 10]
                          :background :white
                          :foreground :black
-                         :size [(- 300 20) :by (- max-height 30)]
+                         :border nil
                          ; todo: change color when selecting items form box,
 ;;                          using renderer/ :listen :selection
                          :listen [:selection
                                   (fn [event]
                                     (println "You selected " (ss/selection event)))]
+;;                           :renderer (fn [item ev] (:Name item) )
                          )
-                            :size [300 :by max-height]
-                            :border nil
+                            :size wine-results-size
+                            :border [2 "Results" 10]
                             ))

-(defn render-property [renderer {:keys [value]}]
+(defn render-property [item {:keys [value]}]
   ; todo clean this keys / value implementation
-  (ss/config! renderer :background :white :foreground :black :border nil))
+  (ss/config! item :background :white :foreground :black :border nil))

-(def result-properties
-  (ss/scrollable (ss/listbox
-                   :id :result-properties
-                   :model ["Description: Hello World" "Location: left right"]
-                   :border [1 14]
-                   :size [(- 400 20) :by (- max-height 30)]
-                   :background :white
-                   :renderer render-property)
+(def wine-properties-list
+  (ss/scrollable
+    (ss/listbox
+      :id :wine-properties
+      :model ["Description: Hello World" "Location: left right"]
+      :border [1 14]
+;;       :size [(- 400 20) :by (- max-height 30)]
+      :background :white
+      :renderer render-property)
+    :size wine-properties-size
+    :border nil))

-                 :size [400 :by max-height]
-                 :border nil
-                 )
-  )
+(def wine-properties-table
+  (ss/scrollable
+    (ss/table
+      :model [
+               :columns ["prop-name" "value"]
+               :rows [
+                       ["desc" "it is"]
+                       ["location" "PR"]
+                       ]
+               ]
+;;       :border [1 14]
+;;       :size [(- 400 20) :by (- max-height 30)]
+      :background :white
+;;       :renderer render-property
+      )
+    :size wine-properties-size
+    :border nil))

 (def container
@@ -126,7 +172,7 @@
     :background bg-color
     :align  :center
     :items [(ss/flow-panel
-                :align :center :vgap 10 :size [210 :by max-height]
+                :align :center :vgap 10 :size main-search-size
                 :items [(ss/flow-panel
                           :size [98 :by 110]
                           :items [wine-com-img title-lbl]
@@ -136,13 +182,15 @@
                           :background bg-color
                           :items [search-input search-button] )]
                 :background bg-color)
-            (ss/horizontal-panel :items [ results result-properties ])]))
+            (ss/horizontal-panel :items [ wine-results wine-properties-table ])]))

 (show-window)
-;;
+
 (display container)

+;; (merge-with + wine-properties-size wine-results-size) ; only if inputs are maps

+;; (ss/config! wine-properties :visible? true)

 ;; (ss/listen window
 ;;   :component-resized (fn [event] (println event)))


Promote conditional request logic

Promote conditional request logic

Conditional requests are possible with all methods, not just GET, HEAD.

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -475,59 +475,55 @@
                    (d/error-deferred (ex-info "" {:status 404
                                                   ::http-response true}))))

+               ;; Conditional request
+
+               (fn [ctx]
+
+                 (if-let [last-modified (round-seconds-up
+                                         (or
+                                          (service/last-modified last-modified ctx)
+                                          (res/last-modified (:resource ctx) ctx)))]
+
+                   (if-let [if-modified-since (some-> req
+                                                      (get-in [:headers "if-modified-since"])
+                                                      parse-date)]
+                     ;; TODO: Hang on, we can't deref in the
+                     ;; middle of a handler like this, we need to
+                     ;; build a chain (I think)
+
+                     (let [last-modified
+                           (if (d/deferrable? last-modified) @last-modified last-modified)]
+
+                       (if (<=
+                            (.getTime last-modified)
+                            (.getTime if-modified-since))
+
+                         ;; exit with 304
+                         (d/error-deferred
+                          (ex-info "" (merge {:status 304
+                                              ::http-response true}
+                                             ctx)))
+
+                         (assoc-in ctx [:response :headers "last-modified"] (format-date last-modified))))
+
+                     (or
+                      ;; TODO: Hang on, we can't deref in the
+                      ;; middle of a handler like this, we need to
+                      ;; build a chain (I think)
+
+                      ;; TODO: Also, haven't we already calculated last-modified?
+
+                      (some->> (if (d/deferrable? last-modified) @last-modified last-modified)
+                               format-date
+                               (assoc-in ctx [:response :headers "last-modified"]))
+                      ctx))
+                   ctx))
+
                (fn [ctx]
                  (case method
                    (:get :head)
                    (d/chain
                     ctx
-
-
-
-                    ;; Conditional request
-
-                    ;; TODO: Don't all methods (not just GET/HEAD)
-                    ;; support conditional requests? Where does it say
-                    ;; that it's just for GET/HEAD methods?
-                    (fn [ctx]
-
-                      (if-let [last-modified (round-seconds-up
-                                              (or
-                                               (service/last-modified last-modified ctx)
-                                               (res/last-modified (:resource ctx) ctx)))]
-
-                        (if-let [if-modified-since (some-> req
-                                                           (get-in [:headers "if-modified-since"])
-                                                           parse-date)]
-                          ;; TODO: Hang on, we can't deref in the
-                          ;; middle of a handler like this, we need to
-                          ;; build a chain (I think)
-                          (let [last-modified
-                                (if (d/deferrable? last-modified) @last-modified last-modified)]
-
-                            (if (<=
-                                 (.getTime last-modified)
-                                 (.getTime if-modified-since))
-
-                              ;; exit with 304
-                              (d/error-deferred
-                               (ex-info "" (merge {:status 304
-                                                   ::http-response true}
-                                                  ctx)))
-
-                              (assoc-in ctx [:response :headers "last-modified"] (format-date last-modified))))
-
-                          (or
-                           ;; TODO: Hang on, we can't deref in the
-                           ;; middle of a handler like this, we need to
-                           ;; build a chain (I think)
-
-                           ;; TODO: Also, haven't we already calculated last-modified?
-
-                           (some->> (if (d/deferrable? last-modified) @last-modified last-modified)
-                                    format-date
-                                    (assoc-in ctx [:response :headers "last-modified"]))
-                           ctx))
-                        ctx))

                     ;; Get body
                     (fn [ctx]


Code tweaks

Code tweaks

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -406,83 +406,72 @@
     (debugf "Returning response: %s" (dissoc response :body))
     response))

-(defn- handle-request [http-resource request]
-  (let [ctx (make-context)]
-    (let [method (:request-method request)
-          options (:options http-resource)
-
-          ;; TODO: Document this debug feature
-          debug (boolean (get-in request [:headers "x-yada-debug"]))]
-
-      (-> ctx
-
-          ;; Populate context
-          (merge
-           {:method method
-            :method-instance (get (:known-methods http-resource) method)
-            :http-resource http-resource
-            :resource (:resource http-resource)
-            :request request
-            :allowed-methods (:allowed-methods http-resource)
-            :options options})
-
-          (d/chain
-
-           available?
-           known-method?
-           uri-too-long?
-           TRACE
-           method-allowed?
-           malformed?
-           authentication
-           authorization
-           fetch
-
-           ;; TODO: Unknown or unsupported Content-* header
-
-           ;; TODO: Request entity too large - shouldn't we do this later,
-           ;; when we determine we actually need to read the request body?
-
-           select-representation
-           exists?
-           check-modification-time
-           if-match
-           invoke-method
-           compute-etag
-           create-response)
-
-          ;; Handle exits
-          (d/catch clojure.lang.ExceptionInfo
-              #(let [data (ex-data %)]
-                 (if (::http-response data)
-                   (if-let [debug-data (when debug (::debug data))]
-                     (assoc data :body (prn-str debug-data))
-                     data)
-
-                   (throw (ex-info "Internal Server Error (ex-info)" data %))
-                   #_{:status 500
-                      :body (format "Internal Server Error: %s" (prn-str data))})))
-
-          (d/catch #(identity
-                     (throw (ex-info "Internal Server Error" {:request request} %))
-                     #_{:status 500 :body
-                        (html
-                         [:body
-                          [:h1 "Internal Server Error"]
-                          [:p (str %)]
-                          [:pre (with-out-str (apply str (interpose "\n" (seq (.getStackTrace %)))))]])}))))))
+(defn- handle-request
+  "Handle Ring request"
+  [http-resource request]
+  (let [method (:request-method request)
+        options (:options http-resource)
+        ;; TODO: Document this debug feature
+        debug (boolean (get-in request [:headers "x-yada-debug"]))
+        ctx (merge
+             (make-context)
+             {:method method
+              :method-instance (get (:known-methods http-resource) method)
+              :http-resource http-resource
+              :resource (:resource http-resource)
+              :request request
+              :allowed-methods (:allowed-methods http-resource)
+              :options options})
+        ]
+
+    (->
+     (d/chain
+      ctx
+      available?
+      known-method?
+      uri-too-long?
+      TRACE
+      method-allowed?
+      malformed?
+      authentication
+      authorization
+      fetch
+      ;; TODO: Unknown or unsupported Content-* header
+      ;; TODO: Request entity too large - shouldn't we do this later,
+      ;; when we determine we actually need to read the request body?
+      select-representation
+      exists?
+      check-modification-time
+      if-match
+      invoke-method
+      compute-etag
+      create-response)
+
+     ;; Handle exits
+     (d/catch clojure.lang.ExceptionInfo
+         #(let [data (ex-data %)]
+            (if (::http-response data)
+              (if-let [debug-data (when debug (::debug data))]
+                (assoc data :body (prn-str debug-data))
+                data)
+
+              (throw (ex-info "Internal Server Error (ex-info)" data %))
+              #_{:status 500
+                 :body (format "Internal Server Error: %s" (prn-str data))})))
+
+     (d/catch #(identity
+                (throw (ex-info "Internal Server Error" {:request request} %))
+                #_{:status 500 :body
+                   (html
+                    [:body
+                     [:h1 "Internal Server Error"]
+                     [:p (str %)]
+                     [:pre (with-out-str (apply str (interpose "\n" (seq (.getStackTrace %)))))]])})))))

 (defrecord HttpResource [resource id handler]
   clojure.lang.IFn
   (invoke [this req]
     (handle-request this req)))
-
-(defn spyctx [label & [korks]]
-  (fn [ctx]
-    (infof "SPYCTX %s: Context is %s"
-            label
-            (pr-str (if korks (get-in ctx (if (sequential? korks) korks [korks])) ctx)))
-    ctx))

 (defrecord NoAuthorizationSpecified []
   service/Service


Fixing brackets issues

Fixing brackets issues

Signed-off-by: himangshu <2f9a8ca67e2403f8494200f6890e3afed1eb6260@gozoomo.com>

--- src/clojure_mailgun_server/message_queue/subscriber.clj
+++ src/clojure_mailgun_server/message_queue/subscriber.clj
@@ -5,6 +5,7 @@
             [langohr.consumers :as lc]
             [clojure-mailgun-server.mailer.mailgun :as mailgun]
             [cheshire.core :as json]
+            [taoensso.timbre :as timbre]
             [clojure.walk :as walk]
             [clojure.java.io :as io]
             [langohr.basic :as lb])
@@ -19,7 +20,8 @@
         msg# (walk/keywordize-keys msg)
         email-request (EmailRequest. (:to msg#) (:subject msg#) (:template msg#) (:values msg#))]
     (timbre/info "[Processing email for Subject through MQ" (:subject email-request) " to " (:to email-request)
-    (mailgun/send-email email-request)))
+    (mailgun/send-email email-request))))
+
 (defn -main
   [& args]
   (let [conn (rmq/connect)
@@ -27,4 +29,4 @@
         qname "clojure-mailgun-server.message-queue"]
     (println (format "[main] subscriber Connected. Channel id: %d" (.getChannelNumber ch)))
     (lq/declare ch qname {:exclusive false :auto-delete true})
-    (lc/subscribe ch qname message-handler {:auto-ack true}))))+    (lc/subscribe ch qname message-handler {:auto-ack true})))


update to new elide-meta

update to new elide-meta

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -381,7 +381,8 @@
        {:meta metadata}))))

 (defn ^:dynamic run-passes [ast]
-  (binding [elides (into #{:line :column :end-line :end-column :file :source} elides)]
+  (binding [elides (merge {:all #{:line :column :end-line :end-column :file :source}}
+                          elides)]
     (-> ast

       uniquify-locals


For `successive-differences`, add doc string and tests

--- test/com/nomistech/clojure_the_language/c_900_appy_stuff/s_100_science/ss_atomic_orbitals.clj
+++ test/com/nomistech/clojure_the_language/c_900_appy_stuff/s_100_science/ss_atomic_orbitals.clj
@@ -55,16 +55,30 @@
              (successive-funcalls (rest fs)
                                   vv))))))

-(defn successive-differences [s]
+(defn successive-differences
+  "The successive differences in `s`.
+  `s` is a sequence of numbers."
+  [s]
   (map - (rest s) s))

-(defn successive-differences-incl-0 [s]
+(defn successive-differences-incl-0
+  "Zero consed on to the successive differences in `s`.
+  `s` is a sequence of numbers."
+  [s]
   (cons 0 (successive-differences s)))

 ;;;; ___________________________________________________________________________

+(fact (successive-differences [1 10 100 1000])
+  => [9 90 900])
+
+(fact (successive-differences-incl-0 [1 10 100 1000])
+  => [0 9 90 900])
+
 (fact (successive-funcalls [inc - /] 9)
   => [10 -10 -1/10])
+
+;;;; ___________________________________________________________________________

 (fact (successive-funcalls [successive-differences-incl-0
                             successive-differences-incl-0


test setting intro

test setting intro

--- test/chat/test/server/db.clj
+++ test/chat/test/server/db.clj
@@ -141,6 +141,10 @@
         user-2-id (db/uuid)]
     (testing "can create a group"
       (is (= group (assoc data :extensions () :admins #{} :intro nil))))
+    (testing "can set group intro"
+      (db/group-set! (group :id) :intro "the intro")
+      (is (= (db/get-group (group :id))
+             (assoc data :extensions () :admins #{} :intro "the intro"))))
     (testing "can add a user to the group"
       (let [user (db/create-user! {:id user-id
                                    :email "foo@bar.com"
@@ -149,7 +153,7 @@
         (is (= #{} (db/get-groups-for-user (user :id))))
         (is (= #{} (db/get-users-in-group (group :id))))
         (db/user-add-to-group! (user :id) (group :id))
-        (is (= #{(assoc data :extensions () :admins #{} :intro nil)}
+        (is (= #{(assoc data :extensions () :admins #{} :intro "the intro")}
                (db/get-groups-for-user (user :id))))
         (is (= #{(dissoc user :group-ids)}
                (set (map (fn [u] (dissoc user :group-ids))


Problem 38 - test.

Problem 38 - test.


Some skeletal tests, should not be run yet

--- test/extracter/core_test.clj
+++ test/extracter/core_test.clj
@@ -2,6 +2,84 @@
   (:require [clojure.test :refer :all]
             [extracter.core :refer :all]))

-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
+(def examples
+  {:fqdn [:Docs
+          [:Doc
+           [:Title "fqdn"]
+           [:Section
+            [:Heading "Purpose"]
+            [:Body "Returns the fully qualified domain name of the host."]]
+           [:Section
+            [:Heading "Resolution"]
+            [:Body "Simply joins the hostname fact with the domain name fact."]]
+           [:Section
+            [:Heading "Caveats"]
+            [:Body
+             "No attempt is made to check that the two facts are accurate or that"
+             "the two facts go together. At no point is there any DNS resolution made"
+             "either."]]]]
+   :blockdevices [:Docs
+                  [:Doc
+                   [:Title "blockdevice_<devicename>_size"]
+                   [:Section
+                    [:Heading "Purpose"]
+                    [:Body "Return the size of a block device in bytes"]]
+                   [:Section
+                    [:Heading "Resolution"]
+                    [:Body
+                     "Parse the contents of /sys/block/<device>/size to receive the size (multiplying by 512 to correct for blocks-to-bytes)"]]
+                   [:Section
+                    [:Heading "Caveats"]
+                    [:Body
+                     "Only supports Linux 2.6+ at this time, due to the reliance on sysfs"]]]
+                  [:Doc
+                   [:Title "blockdevice_<devicename>_vendor"]
+                   [:Section
+                    [:Heading "Purpose"]
+                    [:Body
+                     "Return the vendor name of block devices attached to the system"]]
+                   [:Section
+                    [:Heading "Resolution"]
+                    [:Body
+                     "Parse the contents of /sys/block/<device>/device/vendor to retrieve the vendor for a device"]]
+                   [:Section
+                    [:Heading "Caveats"]
+                    [:Body
+                     "Only supports Linux 2.6+ at this time, due to the reliance on sysfs"]]]
+                  [:Doc
+                   [:Title "blockdevice_<devicename>_model"]
+                   [:Section
+                    [:Heading "Purpose"]
+                    [:Body
+                     "Return the model name of block devices attached to the system"]]
+                   [:Section
+                    [:Heading "Resolution"]
+                    [:Body
+                     "Parse the contents of /sys/block/<device>/device/model to retrieve the model name/number for a device"]]
+                   [:Section
+                    [:Heading "Caveats"]
+                    [:Body
+                     "Only supports Linux 2.6+ at this time, due to the reliance on sysfs"]]]
+                  [:Doc
+                   [:Title "blockdevices"]
+                   [:Section
+                    [:Heading "Purpose"]
+                    [:Body "Return a comma seperated list of block devices"]]
+                   [:Section
+                    [:Heading "Resolution"]
+                    [:Body
+                     "Retrieve the block devices that were identified and iterated over in the creation of the blockdevice_ facts"]]
+                   [:Section
+                    [:Heading "Caveats"]
+                    [:Body
+                     "Block devices must have been identified using sysfs information"]]]]})
+
+
+(deftest parse-resource-test
+  (testing "Parses the example fqdn fact documentation correctly."
+    (is (= (parse-resource "test/fqdn.rb") (:fqdn examples))))
+  (testing "Parses the example blockdevices fact documentation correctly."
+    (let [expected [:Docs [:Doc [:Title "blockdevice_<devicename>_size"] [:Section [:Heading "Purpose"] [:Body "Return the size of a block device in bytes"]] [:Section [:Heading "Resolution"] [:Body "Parse the contents of /sys/block/<device>/size to receive the size (multiplying by 512 to correct for blocks-to-bytes)"]] [:Section [:Heading "Caveats"] [:Body "Only supports Linux 2.6+ at this time, due to the reliance on sysfs"]]] [:Doc [:Title "blockdevice_<devicename>_vendor"] [:Section [:Heading "Purpose"] [:Body "Return the vendor name of block devices attached to the system"]] [:Section [:Heading "Resolution"] [:Body "Parse the contents of /sys/block/<device>/device/vendor to retrieve the vendor for a device"]] [:Section [:Heading "Caveats"] [:Body "Only supports Linux 2.6+ at this time, due to the reliance on sysfs"]]] [:Doc [:Title "blockdevice_<devicename>_model"] [:Section [:Heading "Purpose"] [:Body "Return the model name of block devices attached to the system"]] [:Section [:Heading "Resolution"] [:Body "Parse the contents of /sys/block/<device>/device/model to retrieve the model name/number for a device"]] [:Section [:Heading "Caveats"] [:Body "Only supports Linux 2.6+ at this time, due to the reliance on sysfs" "# Fact: blockdevices"]]]]]
+      (is (= expected (parse-resource "test/blockdevices.rb"))))))
+
+


[#13201] Fix handling of favourits syncing

--- src/status_im/transport/message/core.cljs
+++ src/status_im/transport/message/core.cljs
@@ -100,7 +100,7 @@
         (js-delete response-js "bookmarks")
         (fx/merge cofx
                   (process-next response-js sync-handler)
-                  (browser/handle-bookmarks cofx bookmarks-clj)))
+                  (browser/handle-bookmarks bookmarks-clj)))

       (seq pin-messages)
       (let [pin-messages (types/js->clj pin-messages)]


[CS] Explain transaction and *current-conn*

--- src/vip/data_processor/validation/csv.clj
+++ src/vip/data_processor/validation/csv.clj
@@ -40,6 +40,15 @@
 (defn retry-chunk-without-dupe-ids
   "If inserting a chunk has failed, retry trying to remove duplicate ids"
   [ctx sql-table chunk-values]
+  ;; We need to query for existing ids and retry in the insert in a
+  ;; single transaction to be sure we have a consistent view of what
+  ;; ids already exist. Otherwise, rows that are still "in flight"
+  ;; from the previous commit may get commited between this read and
+  ;; write.
+  ;;
+  ;; Korma's `db/transaction` macro uses a dynamic var to choose which
+  ;; database do the transaction on. We bind it here to ensure that it
+  ;; uses the SQLite database for the table in question.
   (binding [db/*current-conn* (db/get-connection (:db sql-table))]
     (db/transaction
      (let [table (-> sql-table :name keyword)


CMR-6346: Updated index mapping test.

CMR-6346: Updated index mapping test.

--- system-int-test/resources/index_set_granule_mapping.clj
+++ system-int-test/resources/index_set_granule_mapping.clj
@@ -17,8 +17,8 @@
  :native-id-lowercase {:type "keyword", :doc_values true},
  :concept-seq-id {:type "integer"},
  :orbit-start-clat-doc-values {:type "double", :doc_values true},
- :ords-info {:type "integer", :index false},
- :ords {:type "integer", :index false},
+ :ords-info {:type "integer", :index false :store true},
+ :ords {:type "integer", :index false :store true},
  :provider-id {:type "keyword"},
  :readable-granule-name-sort {:type "keyword", :doc_values true},
  :mbr-north-doc-values {:type "float", :doc_values true},


Only do search pagination test if ES store in play

--- test/ctia/http/routes/pagination_test.clj
+++ test/ctia/http/routes/pagination_test.clj
@@ -48,10 +48,11 @@
         (pagination-test-no-sort (str route-pref "/indicators")
                                  {"api_key" "45c1f5e3f05d0"}
                                  [])
-        (pagination-test (str "/ctia/indicator/search?query="
-                              (-> indicators first :title))
-                         {"api_key" "45c1f5e3f05d0"}
-                         [:id :title])
+        (when (= "es" (get-in @ctia.properties/properties [:ctia :store :indicator]))
+          (pagination-test (str "/ctia/indicator/search?query="
+                                (-> indicators first :title))
+                           {"api_key" "45c1f5e3f05d0"}
+                           [:id :title]))
         (pagination-test (str "/ctia/indicator/"
                               (-> created-indicators
                                   first


optimize SQL-parsing a bit for speed - use unchecked-inc

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -77,7 +77,7 @@
                            (= ch ^char tc) (handle-token "result-column-type" i valid-tchar? ts [false false true])
                            ;; catch-all case
                            :else       (do (.append sb ch) [false false false]))]
-          (recur (inc i) e? n? t?))))
+          (recur (unchecked-inc i) e? n? t?))))
     (i/make-sql-template
       (.toString sb)
       (mapv #(let [[p-name p-type] (i/split-param-name-and-type type-start-char %)]


whitespace

whitespace

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -294,10 +294,10 @@
            (not (= :none (get-in tree [:rule] :none))))
       (str "[" (get-in tree [:rule]) "/" cat
            pred
-           "'" (fo tree) "']")
+           " '" (fo tree) "']")

       (= head-first? :none)
-      (str "'" (fo tree) "'/" cat
+      (str " '" (fo tree) "'/" cat
            pred)

       (= head-first? :comp)


Simplify imports

Simplify imports

--- src/clj_dde/core.clj
+++ src/clj_dde/core.clj
@@ -1,10 +1,9 @@
 (ns clj-dde.core
-  [:import
-        [com.pretty_tools.dde.client DDEClientConversation]
-        [com.pretty_tools.dde.client DDEClientEventListener]
-        [com.pretty_tools.dde ClipboardFormat]
-        [com.pretty_tools.dde DDEException]
-        [com.pretty_tools.dde DDEMLException]])
+  (:import [com.pretty_tools.dde.client DDEClientConversation
+                                        DDEClientEventListener]
+           [com.pretty_tools.dde ClipboardFormat
+                                 DDEException
+                                 DDEMLException]))

 #_(System/getProperty "java.library.path")


Fix / -> . bug where files weren't found

--- src/clojars/repo.clj
+++ src/clojars/repo.clj
@@ -23,8 +23,11 @@
   ([group-id artifact-id]
      (find-jar group-id artifact-id (first (versions group-id artifact-id))))
   ([group-id artifact-id version]
-     (maven/pom-to-map (io/file (config :repo) group-id artifact-id version
-                                (format "%s-%s.%s" artifact-id version "pom")))))
+     (try
+       (maven/pom-to-map (io/file (config :repo) group-id artifact-id version
+                                  (format "%s-%s.%s" artifact-id version "pom")))
+       (catch java.io.FileNotFoundException e
+         nil))))

 (defn group-artifacts [group-id]
   (.list (io/file (config :repo) group-id)))
@@ -64,11 +67,14 @@
                           :version version}
                     file (io/file (config :repo) group
                                   artifact version filename)]
+                ;;TODO once db is removed this whole if block
+                ;;can be reduced to the common
+                ;;(try (save-to-file...) (catch ...))
                 (if (.endsWith filename ".pom")
                   (let [contents (slurp body)
                         pom-info (merge (maven/pom-to-map
                                          (StringReader. contents)) info)]
-                    (if (find-jar groupname artifact version)
+                    (if (find-jar group artifact version)
                       (update-jar account pom-info)
                       (add-jar account pom-info))
                     (try
@@ -77,16 +83,18 @@
                         (.delete file)
                         (throw e))))
                   (do
-                    (when-not (find-jar groupname artifact version)
+                    (when-not (find-jar group artifact version)
                       (add-jar account info))
                     (try
                       (save-to-file file body)
                       (catch java.io.IOException e
                         (.delete file)
                         (throw e)))))
-                (ev/record-deploy {:group groupname
-                                   :artifact-id artifact
-                                   :version version} account file))
+                ;;Be consistent with scp only recording pom or jar
+                (when (some #(.endsWith filename %) [".pom" ".jar"])
+                  (ev/record-deploy {:group groupname
+                                     :artifact-id artifact
+                                     :version version} account file)))
               {:status 201 :headers {} :body nil}
               (catch Exception e
                 (pst e)


Make Exploud list the applications from Onix

--- src/exploud/info.clj
+++ src/exploud/info.clj
@@ -6,9 +6,9 @@
              [tyranitar :as tyr]]))

 (defn applications
-  "The list of applications Asgard knows about."
+  "The list of applications Onix knows about."
   []
-  {:names (map :name (asgard/applications))})
+  {:names (map :name (onix/applications))})

 (defn application
   "The information about a particular application."


Insert accepts multiple records, returns number inserted.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -31,15 +31,19 @@
         int-imap))
     imap imap))

-(defn- q-insert [db {:keys [record]}]
-  (assert record)
-  (let [id   (:id record)
-        {old-rmap :rmap old-imap :imap} db]
-    (assert id)
-    (assert (not (contains? old-rmap id)))
-    (let [new-rmap (assoc old-rmap id record)
-          new-imap (indexes-insert old-imap record)]
-      (assoc db :rmap new-rmap :imap new-imap))))
+(defn- q-insert [db {:keys [records]}]
+  (let [{old-rmap :rmap old-imap :imap} db
+        [new-rmap new-imap]
+          (reduce
+            (fn [[int-rmap int-imap] record]
+              (let [id (:id record)]
+                (assert id)
+                (assert (not (contains? int-rmap id)))
+                [(assoc int-rmap id record)
+                 (indexes-insert int-imap record)]))
+            [old-rmap old-imap]
+            records)]
+    [(assoc db :rmap new-rmap :imap new-imap) (count records)]))

 (def- conj-op?
   #{:and :or})
@@ -86,7 +90,7 @@
     (nil? op)
       (constantly true)
     :else
-      (raise "where op not recognized")))
+      (raise (str "where op " op " not recognized"))))

 (defn- order-keyfn [attr dir]
   (assert (#{:asc :dsc} dir))
@@ -167,13 +171,21 @@
       (sorted-map)
       (vals (:rmap db)))))

+(declare exec)
+
+(defn- q-mread [db queries]
+  (vec
+    (map (fn [query] (exec db query))
+         queries)))
+
 (def- query-fns
   {:select q-select
    :count  q-count
    :insert q-insert
    :update q-update
    :delete q-delete
-   :index  q-index})
+   :index  q-index
+   :mread  q-mread})

 (defn exec [db [query-type opts]]
   (if-let [queryfn (query-fns query-type)]


Adding indexed to utils.

Adding indexed to utils.

--- src/hatti/utils.cljs
+++ src/hatti/utils.cljs
@@ -27,4 +27,8 @@
 (defn format
   "Formats a string using goog.string.format, so we can use format in cljx."
   [fmt & args]
-  (apply goog.string/format fmt args))+  (apply goog.string/format fmt args))
+
+(defn indexed [coll]
+  "Given a seq, produces a two-el seq. [a b c] => [[0 a] [1 b] [2 c]]."
+  (map-indexed vector coll))


Crossover needs to be at elevated priority.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -1224,7 +1224,7 @@
                                         :name "X Color"}
                                        {:key "end-color" :type :color :start (colors/create-color :yellow)
                                         :name "End Color"}]
-                           :color :cyan))
+                           :color :cyan :priority 5))

   #_(show/set-cue! 0 13


Fixing small detail

Fixing small detail

--- src/be/dsquare/logging.clj
+++ src/be/dsquare/logging.clj
@@ -87,7 +87,7 @@
 (defn trace-log [msg]
   (try (send be.dsquare.logging/log-agent be.dsquare.logging/update-map
              (merge be.dsquare.logging/*logPrinter* msg))
-       (catch Exception e# _)))
+       (catch Exception e#)))

 (defmacro timelog [message [function & args :as all] & functions]
   `(binding [be.dsquare.logging/*logPrinter* {:fix-token (hash '~&form) :dynamic-token (rand-int 10000)}]
@@ -101,7 +101,7 @@
                           :function   '~function
                           :remove     "remove cache"}
                          be.dsquare.logging/*logPrinter*))
-            (catch Exception e# _))
+            (catch Exception e#))
        ret#)))

 (defmacro timelog-complete [message [function & args :as all] & functions]
@@ -120,7 +120,7 @@
                           :env        '~(str &env)
                           :remove     "remove cache"}
                          be.dsquare.logging/*logPrinter*))
-            (catch Exception e# _))
+            (catch Exception e#))
        ret#)))

 (defmacro log-error [exception-type [function & args :as all] & functions]
@@ -140,7 +140,7 @@
                    :errorMessage  (.getMessage e#)
                    :stackTrace    (.toString e#)
                    :statTraceList (mapv #(str %) (.getStackTrace e#))})
-            (catch Exception e# _)))))
+            (catch Exception e#)))))

 (defmacro log-error-return [return-message [function & args :as all] & functions]
   `(try


Make most store test functions public.

Make most store test functions public.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -38,7 +38,7 @@
        (into (sorted-map))))

-(defn- test-put-attributes
+(defn test-put-attributes
   "The put! method in a store should return a block with an updated content or
   reader, but keep the same id, extra attributes, and any non-stat metadata."
   [store]
@@ -59,7 +59,7 @@
     (is (true? (block/delete! store (:id stored))))))

-(defn- test-block
+(defn test-block
   "Determines whether the store contains the content for the given identifier."
   [store id content]
   (testing "block stats"
@@ -81,7 +81,7 @@
           "block only contains id and size"))))

-(defn- test-restore-block
+(defn test-restore-block
   "Tests re-storing an existing block."
   [store id content]
   (let [status     (block/stat store id)
@@ -92,7 +92,7 @@
            (:stored-at new-status)))))

-(defn- test-list-stats
+(defn test-list-stats
   "Tests the functionality of list's marker option."
   [store ids n]
   (let [prefix (-> (block/list store :limit 1) first :id multihash/hex (subs 0 4))]


making mac validation common

making mac validation common

--- src/celestial/provider.clj
+++ src/celestial/provider.clj
@@ -82,5 +82,9 @@

 ; common validations
 (validation :ip
-            (when-not-nil (partial re-find #"\d+\.\d+\.\d+\.\d+") "must be a legal ip address"))
+    (when-not-nil (partial re-find #"\d+\.\d+\.\d+\.\d+") "must be a legal ip address"))
+
+(validation :mac
+  (when-not-nil (partial re-find #"^([0-9A-Fa-f]{2}[:-]){5}([0-9A-Fa-f]{2})$") "must be a legal mac address"))
+
 (test #'mappings)


fix annoying flash of double tags

fix annoying flash of double tags

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -103,15 +103,15 @@
   (when-not (get-in @app-state [:threads thread-id])
     (transact! [:threads thread-id] (constantly {:id thread-id
                                                  :messages []
-                                                 :tag-ids #{}})))
+                                                 :tag-ids #{}
+                                                 :mentioned-ids #{}} )))
   (transact! [:user :open-thread-ids] #(conj % thread-id)))

 (defn add-message! [message]
   (maybe-create-thread! (message :thread-id))
   (transact! [:threads (message :thread-id) :messages] #(conj % message))
-
-  (transact! [:threads (message :thread-id) :tags] #(apply conj % (message :mentioned-tag-ids)))
-  (transact! [:threads (message :thread-id) :mentioned-ids] #(apply conj % (message :mentioned-user-ids))))
+  (transact! [:threads (message :thread-id) :tag-ids] #(apply conj (set %) (message :mentioned-tag-ids)))
+  (transact! [:threads (message :thread-id) :mentioned-ids] #(apply conj (set %) (message :mentioned-user-ids))))

 (defn add-open-thread! [thread]
   ; TODO move notifications logic out of here


Log when terminating instances

Log when terminating instances

--- src/circle/backend/ec2.clj
+++ src/circle/backend/ec2.clj
@@ -141,6 +141,7 @@
 (defn terminate-instances!
   [& instance-ids]
   (when (seq instance-ids)
+    (infof "terminating %s" (str/join ", " instance-ids))
     (with-ec2-client client
       (-> client
           (.terminateInstances (TerminateInstancesRequest. instance-ids))


fix Howler

fix Howler

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -277,7 +277,7 @@
                        {:prompt "Choose a Bioroid ICE to install"
                         :choices (req (filter #(and (= (:type %) "ICE") (has? % :subtype "Bioroid"))
                                               ((if (= fr "HQ") :hand :discard) corp)))
-                        :effect (req (let [newice (assoc target :zone (:zone card))
+                        :effect (req (let [newice (assoc target :zone (:zone card) :rezzed true)
                                            hndx (ice-index state card)
                                            ices (get-in @state (cons :corp (:zone card)))
                                            newices (apply conj (subvec ices 0 hndx) newice (subvec ices hndx))]
@@ -285,7 +285,6 @@
                                        (swap! state update-in (cons :corp (:zone target))
                                               (fn [coll] (remove-once #(not= (:cid %) (:cid target)) coll)))
                                        (update! state side (assoc card :howler-target newice))
-                                       (swap! state update-in [:run :position] inc)
                                        (trigger-event state side :corp-install newice)))} card nil)))}]
     :events {:run-ends {:req (req (:howler-target card))
                         :effect (effect (trash card {:cause :self-trash})


Actually loop when collecting tweets

Actually loop when collecting tweets

Looks like a (recur) call was lost when
transforming commented snippets into actual
functions.

--- src/clj/skytwit/server.clj
+++ src/clj/skytwit/server.clj
@@ -145,7 +145,8 @@
              (when-let [tweets (<! ch)]
                (->> tweets
                     (filter #(= (:user %) uid))
-                    (swap! at update :tweets concat))))))
+                    (swap! at update :tweets concat))
+               (recur)))))

 (defroutes routes
   (GET "/" _


fix invalid neg delta

fix invalid neg delta

--- src/cljc/commos/delta.cljc
+++ src/cljc/commos/delta.cljc
@@ -32,7 +32,7 @@
                        [[:ex full-ks v]]

                        :else
-                       [[:ex (pop full-ks) (peek full-ks)]])))]
+                       [[:ex (pop full-ks) [(peek full-ks)]]])))]
     (mapcat (partial step []) (flatten-keys m))))

 (defn negative-deltas


MORE UI WORK

MORE UI WORK

--- src/cljs/bmihw/submit.cljs
+++ src/cljs/bmihw/submit.cljs
@@ -2,9 +2,16 @@
   (:require [bmihw.common :refer [auth fb]]
             [reagent-forms.core :refer [bind-fields]]))

-(defn submit-to-fb [state]
+(defn update-state! [state key e]
+  (let [new-state (swap! state assoc key (-> e .-target .-value))
+        {:keys [username keyword content]} new-state
+        submit (.querySelector js/document "#submit")]
+    (set! (.-disabled submit) (not (and (or (seq username) (seq keyword))
+                                        (seq content))))))
+
+(defn submit-to-fb! [state]
   (.push fb
-    (clj->js state)
+    (clj->js @state)
     (fn [error]
       (when error
         (js/alert (str "An error occurred: " error))))))
@@ -14,13 +21,13 @@
     [:div [:h2 "Submit your insult."]
      [:div [:div
             [:input {:type :text :name :username :placeholder "Username"
-                     :on-change #(swap! state assoc :username (-> % .-target .-value))}]
+                     :on-change #(update-state! state :username %)}]
             [:br]
             [:input {:type :text :name :keyword :placeholder "Keyword"
-                     :on-change #(swap! state assoc :keyword (-> % .-target .-value))}]
+                     :on-change #(update-state! state :keyword %)}]
             [:br]
             [:input {:type :text :name :content :placeholder "Content"
-                     :on-change #(swap! state assoc :content (-> % .-target .-value))}]
+                     :on-change #(update-state! state :content %)}]
             [:br]
-            [:input {:type :submit :value "Submit"
-                     :on-click #(submit-to-fb @state)}]]]]))+            [:input {:type :submit :value "Submit" :id "submit" :disabled true
+                     :on-click #(submit-to-fb! state)}]]]]))


add x-y-order

add x-y-order

--- src/cljs/signet/graph.cljs
+++ src/cljs/signet/graph.cljs
@@ -94,6 +94,19 @@
               (range (count v)))]))
          (into {}))))

+(defn nodes->x-y-order [{:keys [nodes] :as cg}]
+  (let [x-order (mapv first (sort-by val #(> (count %1) (count %2)) nodes))]
+    (assoc cg
+      :x-order x-order
+      :y-order (vec (loop [order x-order
+                           y-order []
+                           i true]
+                      (if (empty? order)
+                        y-order
+                        (recur (rest order) (if i
+                                              (concat y-order [(first order)])
+                                              (concat [(first order)] y-order))
+                               (not i))))))))

 (defn explore-commit-graph
   "Run the pipeline"
@@ -103,4 +116,5 @@
        distinct-nodes
        nodes->order
        find-merge-links
-       nodes->links))
+       nodes->links
+       nodes->x-y-order))


Fix incorrect curly brace position

Fix incorrect curly brace position

--- src/cljs/zetawar/data.cljs
+++ src/cljs/zetawar/data.cljs
@@ -905,8 +905,7 @@
       :terrain-type :mountains}
      {:q 2
       :r 4
-      :terrain-type :plains
-      }
+      :terrain-type :plains}
      {:q 3
       :r 4
       :terrain-type :plains}


Add asserts that all cloudfiles connect functions aren't nil

--- src/clojars/cloudfiles.clj
+++ src/clojars/cloudfiles.clj
@@ -19,6 +19,10 @@
   ([user key container-name]
    (connect user key container-name "rackspace-cloudfiles-us"))
   ([user key container-name provider]
+   (assert (some? user))
+   (assert (some? key))
+   (assert (some? container-name))
+   (assert (some? provider))
    (let [bs (jc/blobstore provider user key)]
      (when-not (jc/container-exists? bs container-name)
        (jc/create-container bs container-name :public-read? true))
@@ -44,7 +48,7 @@
               (assoc m k (f md)))
       {}
       metadata-builders)))
-
+
 (defn artifact-metadata [conn path]
   (when-let [md (apply-conn jc/blob-metadata conn path)]
     (metadata->map md)))


notes on splitting up draw ns.

notes on splitting up draw ns.

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -6,6 +6,7 @@
             [nonaga.rules.rings :as r])
   (:use-macros [dommy.macros :only [sel1]]))

+; Used all over the place. Perhaps util?
 (defn hex->svg [[hex-x hex-y]]
   (let [width  40
         half (/ width 2)
@@ -13,6 +14,7 @@
         svg-y (+ 160 (* width hex-y))]
     [svg-x svg-y]))

+; draw-rings, draw-potential-rings, drawing last ring
 (defn ring
   ([color coord] (ring color nil coord))
   ([color click [x y :as coord]]
@@ -26,6 +28,7 @@
             "onClick"     click
             "key"         (str "ring:" x "," y)})))

+; draw-marbles, draw-valid-marble-moves
 (defn marble
   ([color coord] (marble color nil coord))
   ([color click [x y :as coord]]
@@ -37,24 +40,30 @@
             "style"   {"cursor" (if click "pointer")}
             "key"     (str "marble" x "," y)})))

+; move-ring
 (def opposite
   {:red :blue
    :blue :red})

+; draw-valid-marble-moves
 (def light-colors
   {:red :pink
    :blue :lightblue})

+; Used quite a bit. Perhaps should switch to using atoms then this will all be
+; a bit more natural.
 (defn update-state [component update-fn]
   (fn []
     (let [old-state (.-wrapper (.-state component))]
       (.setState component #js {:wrapper (update-fn old-state)}))))

+; draw-valid-marble-moves
 (defn move-marble [component color from to]
   (update-state component
                 #(-> % (n/move-ball color from to)
                      (assoc :event [:marble-moved color]))))

+; render, own namespace?
 (defn draw-valid-marble-moves [component state]
   (let [[type & event-data] (:event state)]
     (when (= :marble-selected type)
@@ -65,9 +74,11 @@
                        (hex->svg hex)))
               (b/valid-destinations state selected))))))

+; draw-marbles
 (defn start-marble-move [component color coord]
   (update-state component #(assoc % :event [:marble-selected color coord])))

+; render, own ns?
 (defn draw-marbles [component state color]
   (let [etype  (get-in state [:event 0])
         cp     (get-in state [:event 1])
@@ -81,9 +92,11 @@
          coords (map hex->svg coords))))

 ; This is the same as start-marble-move
+; draw-rings
 (defn ring-selected [component color coord]
   (update-state component #(assoc % :event [:ring-selected color coord])))

+; render. own ns?
 (defn draw-rings [component state]
   (let [[type & event-data] (:event state)
         coords (:rings state)]
@@ -97,6 +110,7 @@
          coords (map hex->svg coords))))

 ; Same as move-marble
+; draw-potential-rings
 (defn move-ring [component color from to]
   (update-state component
                 #(-> % (n/move-ring from to)
@@ -105,6 +119,7 @@

 ; These things should be a multi method that dispatches on state. Or I could
 ; have state records with a draw protocol.
+; render. own ns.
 (defn draw-potential-rings [component state]
   (let [[type & event-data] (:event state)
         coords (:rings state)]


fixed × rendering

fixed × rendering

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -472,16 +472,21 @@

 (r/defc modal []

-  [:#myModal.modal.fade {:tabindex -1
-                         :role "dialog"
-                         :aria-labelledby "myModalLabel"}
+  [:#myModal.modal {:tabindex -1
+                    :role "dialog"
+                    :aria-labelledby "myModalLabel"
+                    :style
+                    {:display "block"
+                     :right "50%"}}
    [:.modal-dialog {:role "document"}
     [:.modal-content
      [:.modal-header
       [:button.close {:type"button"
                       :data-dismiss "modal"
                       :aria-label "Close"}
-       [:span {:aria-hidden "true"} "×"]]
+       [:span {:aria-hidden "true"
+               :dangerouslySetInnerHTML
+               {:__html "×"}} ]]
       [:h4#myModalLabel.modal-title "Modal title"]]
      [:.modal-body
       "Content goes here"]


colur map tweaks

colur map tweaks

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -100,7 +100,8 @@
     :outer-low "#ffffbf"
     :outer-high "#ffffbf"
     :high "#91bfdb"
-    :dot "white"
+    :header "#91bfdb"
+    :dot "black"
     }
    :brewer-RdYl
    {:low "white"
@@ -108,6 +109,7 @@
     :outer-low "#ffffbf"
     :outer-high "#ffffbf"
     :high "white"
+    :header "#fc8d59"
     :dot "black"}
    :brewer-YlRd
    {:low "white"
@@ -115,6 +117,7 @@
     :outer-low "#fc8d59"
     :outer-high "#fc8d59"
     :high "white"
+    :header "#fc8d59"
     :dot "black"}
    :brewer-BuGn
    {:low "white"
@@ -122,6 +125,7 @@
     :outer-low "#2c7fb8"
     :outer-high "#2c7fb8"
     :high "white"
+    :header "#2c7fb8"
     :dot "black"}
    :brewer-GnBu
    {:low "white"
@@ -129,6 +133,7 @@
     :outer-low "#7fcdbb"
     :outer-high "#7fcdbb"
     :high "white"
+    :header "#3c8fc8"
     :dot "black"}
    :christina
    {:low "white"
@@ -136,6 +141,7 @@
     :outer-low "#578FD2"
     :outer-high "#578FD2"
     :high "white"
+    :header "#578FD2"
     :dot "black"
     }
    :anitsirch
@@ -144,6 +150,7 @@
     :outer-low "#8FB4E1"
     :outer-high "#8FB4E1"
     :high "white"
+    :header "#578FD2"
     :dot "black"
     }
    })
@@ -171,27 +178,31 @@
   (/ (Math.log10 (inc input)) 2)
   )

+
 (defn exp-transform
   "invert the log transform"
   [output]
   (dec (Math.pow 10 (* output 2)))
   )

+;; test square: insert to check mixin behviour
 (r/defc square < r/static [slider value fill]
   [:div.bar {:style
              {:background-color (important fill)
               :height (px 10)
-              :width (px 10)
-          }}]
-  )
+              :width (px 10)}}])
+
+
+(r/defc zero-bar < r/static [slider value]
+  [:div.bar {:style {:background-color "#eeeeee"
+                     :width "calc(25px - )"
+                     ;:width (str (bar-width slider value) "%")
+                     }}])

 (r/defc bar < r/static [slider value fill]
   [:div.bar {:style {:background-color fill
-                     :width (str (bar-width slider value) "%")}}
-   #_(square (:inner (colour-map (r/react core/app))))
-   ])
-
+                     :width (str (bar-width slider value) "%")}}])

 (r/defc dot < r/static r/reactive [slider size value & [relative]]
@@ -210,22 +221,24 @@
                          )}}])
   )

+
 (def extra-right 40)
 (def last-pad-right (important (px extra-right)))
 (def axis-margin 25)

+
 (defn dot-size [slider]
   (Math.round (- 12 (* 4 (- 1 slider)))))

+
 (r/defc chart-cell < r/reactive [row slider]
   (let [colours (colour-map (r/react core/app))]
-    [:td.chart-cell {:style {:padding-left (px axis-margin)
+    [:td.chart-cell {:style {:padding-left (important (px axis-margin))
                              :padding-right last-pad-right}}

      [:div.bar-chart
-      (r/with-key (square slider (- (:inner-low row) (:outer-low row)) (:inner colours)) :bar0)
       (r/with-key (bar slider (- (:outer-low row) (* min-outer-low slider)) (:low colours)) :bar1)
       (r/with-key (bar slider (- (:inner-low row) (:outer-low row)) (:outer-low colours)) :bar2)
       (r/with-key (bar slider (- (:inner-high row) (:inner-low row)) (:inner colours)) :bar3)
@@ -313,7 +326,7 @@
     [:thead
      [:tr
       (for [column-key column-keys :when (-> headers column-key :shown)]
-        (r/with-key (table-header (:outer-low (colour-map ap))
+        (r/with-key (table-header (:header (colour-map ap))
                                   ap
                                   (column-key headers)
                                   column-key
@@ -322,7 +335,7 @@
       [:th
        {:key :last
         :style {:width "auto"
-                :background-color (:outer-low (colour-map ap))
+                :background-color (:header (colour-map ap))
                 :color "#ffffff !important"
                 }}
        [:.slider-container


experimental: main::data/modal interferes with correct slider operation in render-map-data

--- src/prais2/main.cljs
+++ src/prais2/main.cljs
@@ -65,14 +65,14 @@
    [:.row
     [:ul.nav.nav-tabs {:role "tablist"
                        :style {:clear "both"}}
-     [:li {:role "presentation"}
+     [:li.active {:role "presentation"}
       [:a#map-tab {:href "#"
            :aria-controls "mapped-data"
            :role "tab"
            :data-toggle "tab"
            :on-click #(do (.preventDefault (.-nativeEvent %))
                        (.tab (js/$ "map-tab") "show"))} "Map"]]
-     [:li.active {:role "presentation"}
+     [:li {:role "presentation"}
       [:a#table-tab {:href "#"
            :aria-controls "data-table"
            :role "tab"
@@ -83,24 +83,27 @@
 (rum/defc render-data-tab-panes < rum/reactive []
   (let [data ((data/table-data (:datasource (rum/react core/app))))]
     [:.tab-content
-     [:.tab-pane {:id "mapped-data"}
-      (render-map-data)]
-     [:.tab-pane.active {:id "data-table"}
+     [:.tab-pane.active {:id "mapped-data"}
+      ;(render-map-data)
+      ]
+     [:.tab-pane {:id "data-table"}
       (data/table1 core/app data event-bus)]])
-  )
+  (render-map-data)
+)

 (rum/defc render-data < rum/reactive ;(core/monitor-react "DATA>")
   [id]
   (let [data ((data/table-data (:datasource (rum/react core/app))))]
     [:div
      (map-indexed key-with
-                  [(data/modal)
+                  [;(data/modal)
                    (render-data-tabs)
                    (render-data-tab-panes)
                    ;(render-map-data)
-                   ;(data/table1 core/app data event-bus)
-
-                   (data/option-menu event-bus)])]))
+                                        ;(data/table1 core/app data event-bus)
+
+                   (data/option-menu event-bus)])])
+)

 (defn valid-session-id
   ([session-id]
@@ -181,7 +184,7 @@
        (.pushState js/history [] "" (routes/map-data))
        (map-indexed key-with
                     [(chrome/header)
-                     (render-map-data)
+                     ;(render-map-data)
                      (chrome/footer)]))

      (= page :data)


[#1156] Use url-request-format when revoking API keys

* GAE requires an empty body for DELETE.

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/user_details.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/user_details.cljs
@@ -23,7 +23,7 @@
             [org.akvo.flow.dashboard.ajax-helpers :refer (default-ajax-config)]
             [om.core :as om :include-macros true]
             [sablono.core :as html :refer-macros (html)]
-            [ajax.core :refer (ajax-request GET POST PUT DELETE)])
+            [ajax.core :refer (url-request-format GET POST PUT DELETE)])
   (:require-macros [org.akvo.flow.dashboard.t :refer (t>)]))

 (defn panel-header-section [{:keys [user close!]} owner]
@@ -225,7 +225,8 @@
 (defn revoke-apikeys [owner user]
   (DELETE (str "/rest/users/" (get user "keyId") "/apikeys")
           (merge default-ajax-config
-                 {:handler (fn [response]
+                 {:format (url-request-format)
+                  :handler (fn [response]
                              (om/set-state! owner {:access-key nil :secret nil})
                              (dispatch :new-access-key {:access-key nil :user user}))})))


Man, these policy documents are awkward

Man, these policy documents are awkward

--- src/eulalie/util/query.clj
+++ src/eulalie/util/query.clj
@@ -24,28 +24,37 @@
    csk/->kebab-case-keyword (json/decode s true)))

 (defn policy-key-out [k]
-  (if (and (keyword? k) (namespace k))
-    (str (csk/->CamelCaseString (namespace k))
-         ":"
-         (csk/->CamelCaseString (name k)))
-    (csk/->CamelCaseString k)))
+  (cond (and (keyword? k) (namespace k))
+        (str (csk/->CamelCaseString (namespace k))
+             ":"
+             (csk/->CamelCaseString (name k)))
+        (string? k) k
+        :else (csk/->CamelCaseString k)))

 (defn policy-key-in [k]
   (let [k (cond-> k (keyword? k) name)]
-    (if (string? k)
+    (cond
+      (= "AWS" k) k
+      (string? k)
       (let [segments (str/split (name k) #":" 2)]
         (apply keyword (map csk/->kebab-case-string segments)))
-      (csk/->kebab-case-keyword k))))
+      :else (csk/->kebab-case-keyword k))))

-(defn transform-policy-statement [key-parser {:keys [statement] :as p}]
-  (assoc p :statement
-         (for [{:keys [action effect] :as clause} statement]
-           (cond-> clause
-             action (assoc :action (functor/fmap key-parser action))
-             effect (assoc :effect (key-parser effect))))))
+(defn transform-policy-statement [xform-value {:keys [statement] :as p}]
+  (assoc
+   p :statement
+   (for [{:keys [principal] :as clause} statement]
+     (-> clause
+         ;; Stringify, so we don't later rename
+         (assoc :principal
+                (if (map? principal)
+                  (util/mapkeys name principal)
+                  (name principal)))
+         (update-in [:action] xform-value)
+         (update-in [:effect] xform-value)))))

-(defn policy-json-out [m]
-  (->> m
+(defn policy-json-out [policy]
+  (->> policy
        (transform-policy-statement policy-key-out)
        (csk-extras/transform-keys policy-key-out)
        json/encode))


fixed artwork not changing

fixed artwork not changing

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -81,11 +81,10 @@

 (defn current-track-tags-view [data owner]
   (reify
-    om/IWillUpdate
-    (will-update [_ _ _]
+    om/IDidUpdate
+    (did-update [_ _ _]
       (let [prev-state (om/get-state owner)]
-        (if-not (or (= (:track-id prev-state) (:current-track-id data))
-                    (nil? (:current-track-id data)))
+        (if (not= (:track-id prev-state) (:current-track-id data))
           (let [picture-data (first
                                (.-picture
                                  (.-tags


Fix to close database connections properly, whilst also allowing fine grained control over connections.

--- src/grafter/rdf/sesame.clj
+++ src/grafter/rdf/sesame.clj
@@ -329,17 +329,21 @@

   (pr/add-statement
     ([this statement]
-       (pr/add-statement (.getConnection this) statement))
+       (with-open [connection (.getConnection this)]
+         (pr/add-statement connection statement)))

     ([this graph statement]
-       (pr/add-statement (.getConnection this) graph statement)))
+       (with-open [connection (.getConnection this)]
+         (pr/add-statement (.getConnection this) graph statement))))

   (pr/add
     ([this triples]
-       (pr/add (.getConnection this) triples))
+       (with-open [connection (.getConnection this)]
+         (pr/add connection triples)))

     ([this graph triples]
-       (pr/add (.getConnection this) graph triples))))
+       (with-open [connection (.getConnection this)]
+         (pr/add connection graph triples)))))

 (defn resource-array #^"[Lorg.openrdf.model.Resource;" [& rs]
   (into-array Resource rs))


work on filtering and peg-revision uris

work on filtering and peg-revision uris

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -9,7 +9,6 @@
 ;; TODO is --stop-on-copy on log really a good idea?
 ;; TODO maybe print log message / committer info (could use awt/swing popup)?
 ;; TODO pass all '--' options (e.g. --username) to svn?
-;; TODO item, term used to be global: refactor to avoid passing them so much!
 ;; TODO add command-line switch for case insensitivity!

 (def shhh "--non-interactive")  ; suppress svn user prompts
@@ -18,7 +17,6 @@
 ;; copy to avoid following the history of a differently-named object.

 (defn log [item] (:out (sh "svn" "log" shhh "--stop-on-copy" "--xml" item)))
-;;(defn log [item] (slurp "xml"))

 ;; Try to explain why this has failed.

@@ -60,10 +58,13 @@
     (list (str path "@" r1) (str path "@" r2))
     (list (str "-r" r1 ":" r2) path)))

+(defn baseitem [item] (clojure.string/replace item #"@[0-9]+$" ""))
+
 ;; A string containing the output of "diff" on the two svn revision of item.

 (defn diff [r1 r2 item]
-  (let [v (vpaths r1 r2 item item)]
+  (let [item (baseitem item)
+        v (vpaths r1 r2 item item)]
     (sh "svn" "diff" "--diff-cmd" "diff" "-x" "-u0" shhh (first v) (second v))))

 ;; Obtain a diff from svn for the given item between the specified revisions.
@@ -73,54 +74,59 @@
 ;; vector of the names of files where the filter term appears on a changed line.
 ;; If no filter term is given, a changed file automatically matches.

-(defn matching-files [r1 r2 item term]
+(defn matching-files [r1 r2 item filt]
   (let [blocks (rest (split (:out (diff r1 r2 item)) #"^Index: |\nIndex: "))]
     (remove nil?
             (into []
                   (for [block blocks]
-                    (let [lines (split-lines block)
-                          filename (trim (first lines))
-                          changes (filter #(re-matches #"^[+-][^+-].*" %) lines)
-                          re (re-pattern (str ".*" term ".*"))
-                          matching-line-in #(re-matches re %)]
-                      (if (some matching-line-in changes) filename)))))))
+                    (let [matching-line-in? #(re-matches (re-pattern filt) %)
+                          diff-line? #(re-matches #"^[+-][^+-].*" %)
+                          strip+- #(clojure.string/replace % #"^[+-]" "")
+                          all-lines (split-lines block)
+                          diff-lines (filter diff-line? all-lines)
+                          changes (map strip+- diff-lines)
+                          filename (trim (first all-lines))]
+                      (if (some matching-line-in? changes) filename)))))))

-;; Run "svn diff" on the file/pathname in index. The format of the file/path
+;; Run "svn diff" on the file/pathname in object. The format of the file/path
 ;; name following "Index:" in diff's output depends on the argument: If the
-;; argument is a filesystem pathname, the index name is absolute, and we can
-;; simply use that. If the argument is a uri, the index name is relative to the
+;; argument is a filesystem pathname, the object name is absolute, and we can
+;; simply use that. If the argument is a uri, the object name is relative to the
 ;; base item name. If the base item name was the uri to a file (and therefore a
 ;; complete pathname) we can use item; if it was the uri to a directory, we have
-;; to concatenate the item and index to form a complete pathname.
+;; to concatenate the item and object to form a complete pathname.

-(defn svndiff [r1 r2 index item]
-  (let [r (re-pattern (str "^.*/" index "$"))
+(defn svndiff [r1 r2 object item]
+  (let [item (baseitem item)
+        r (re-pattern (str "^.*/" object "$"))
         p (if (uri? item)
-            (if (re-matches r item) item (str item "/" index))
-            index)
+            (if (re-matches r item) item (str item "/" object))
+            object)
         v (vpaths r1 r2 p item)]
     (sh "svn" "diff" (first v) (second v))))

-;; Given a list of revision pairs, diff those for which the given filter term (if
-;; any) is present on a changed line in that pair. If no filter term is given,
-;; diff all changed files from all revision pairs.
+;; Given a list of revision pairs, diff those for which the given filter term
+;; (if any) is present on a changed line in that pair. If no filter term is
+;; given, diff all changed files from all revision pairs.

-(defn diffrevpairs [item term revpairs]
+(defn diffrevpairs [item filt revpairs]
   (when (seq revpairs)
     (let [r1 (first revpairs)
           r2 (first (rest revpairs))
-          mf (matching-files r1 r2 item term)]
+          mf (matching-files r1 r2 item filt)]
       (println (str "Checking: r" r1 " vs r" r2))
-      (doseq [index mf] (svndiff r1 r2 index item))
-      (diffrevpairs item term (rest (rest revpairs))))))
+      (doseq [object mf] (svndiff r1 r2 object item))
+      (diffrevpairs item filt (rest (rest revpairs))))))

 (defn usage []
-  (println (str "\nUsage: revdiff item [term]\n"))
-  (println "  item : svn uri or name of versioned working-copy object")
-  (println "  term : only show diffs with term present on a changed line\n"))
+  (println (str "\nUsage: revdiff item [regex]\n"))
+  (println "  item  : svn uri or name of versioned working-copy object")
+  (println "  regex : only show diffs where a changed line matches regex\n"))

 (defn -main [& args]
-  (let [item (first args) term (second args)]
+  (let [item (first args) filt (or (second args) ".*")]
     (if (not item)
       (usage)
-      (diffrevpairs item term (revpairs (revlist item) item)))))
+      (do
+        (diffrevpairs item filt (revpairs (revlist item) item))
+        (shutdown-agents)))))


transduce key-event to game-event directly in channel

--- src/tetrij/core.cljs
+++ src/tetrij/core.cljs
@@ -114,8 +114,24 @@
                    :tile-position initial-tile-position})))

 ;; event handling
+(defn keycode->event [code]
+  (case code
+    37 :move-left  ;; left arrow
+    39 :move-right ;; right arrow
+    69 :rotate-ccw ;; e
+    82 :rotate-cw  ;; r
+    38 :rotate-cw  ;; up arrow
+    40 :move-down  ;; down arrow
+    32 :drop-tile  ;; space
+    80 :pause
+    nil))
+
+(def keyevent->event (comp (map #(.-keyCode %))
+                           (map keycode->event)
+                           (remove nil?)))
+
 (def ticker (atom nil))
-(def user-chan (chan))
+(def user-chan (chan 1 keyevent->event))
 (def event-chan (chan (dropping-buffer 1)))
 (def pause-chan (chan))

@@ -133,19 +149,10 @@

 (set! (.-onkeydown js/document) #(put! user-chan %))
 (go-loop []
-  (let [key-code (.-keyCode (<! user-chan))
-        event (case key-code
-                37 :move-left  ;; left arrow
-                39 :move-right ;; right arrow
-                69 :rotate-ccw ;; e
-                82 :rotate-cw  ;; r
-                38 :rotate-cw  ;; up arrow
-                40 :move-down  ;; down arrow
-                32 :drop-tile  ;; space
-                80 (do (>! pause-chan :pause) ;; p
-                       nil)
-                nil)]
-    (if event (>! event-chan event))
+  (let [event (<! user-chan)]
+    (if (= :pause event)
+      (>! pause-chan event)
+      (>! event-chan event))
   (recur)))

 (def base-score [40 100 300 1200])


Fix #4: take a global write lock when writing on the json

--- src/b3api/core.clj
+++ src/b3api/core.clj
@@ -12,7 +12,7 @@
 (defonce channel-list (atom [])) ;; The list of open websockets
 (defonce status       (atom {})) ;; The actual status, once read from the json
 (defonce tokens       (atom [])) ;; List of master tokens
-
+(defonce o            (Object.)) ;; The global lock object

 (defn log-append!
   "Append a new message to the log file"
@@ -35,8 +35,9 @@
 (defn write-status-json!
   "Writes the status atom into the json status file"
   []
-  (->> (generate-string @status)
-       (spit (str fs/*cwd* "/data/status.json"))))
+  (locking o
+    (->> (generate-string @status)
+         (spit (str fs/*cwd* "/data/status.json")))))

 (defn broadcast!


fix pmc-rotale

fix pmc-rotale

--- docs/sc-book/sc-one.clj
+++ docs/sc-book/sc-one.clj
@@ -330,13 +330,12 @@
         src (* (pm-osc freq (* mod freq) (env-gen:kr env :timeScale art, :levelScale tone) 0)
                (env-gen:kr env :timeScale art, :levelScale 0.3))
         src (pan2 src pan)
-        src (* src (env-gen:kr env :timeScale (* art 1.3) :levelScale (rrand 0.1 0.5) :action :free))]
+        src (* src (env-gen:kr env :timeScale (* art 1.3) :levelScale (ranged-rand 0.1 0.5) :action FREE))]
     (out 0 src)))

 ;;Synth("PMCrotale", ["midi", rrand(48, 72).round(1), "tone", rrand(1, 6)])

 (pmc-rotale :midi (ranged-rand 48 72) :tone (ranged-rand 1 6))
-

 ;;Page 25
 ;;


DM #20 - Fixing build

DM #20 - Fixing build

--- integration/objective8/api/comments_integration_tests.clj
+++ integration/objective8/api/comments_integration_tests.clj
@@ -74,7 +74,7 @@
                 (:status response) => 423))))

-(facts "GET /api/v1/objectives/:id/comments"
+(facts "GET /api/v1/objectives/:id/comments" :integration
        (against-background
         [(before :contents (do (helpers/db-connection)
                                (helpers/truncate-tables)))


s/(def)/(defonce)/

s/(def)/(defonce)/

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -14,7 +14,7 @@
    [dag_unify.core :refer [deserialize dissoc-paths
                            fail? fail-path get-in serialize strip-refs]]))

-(def medium-model (promise))
+(defonce medium-model (promise))
 (defn medium []
   (if (and (not (nil? medium-model))
            (realized? medium-model))


operations hosting refactoring

operations hosting refactoring

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -168,7 +168,7 @@
    {:choices {:req #(and (= (:type %) "ICE") (has? % :subtype "Bioroid") (not (:rezzed %)))}
     :msg (msg "rez " (:title target) " at no cost")
     :effect (effect (rez target {:no-cost true})
-                    (host (get-card state target) (get-card state (assoc card :zone [:discard]))))}
+                    (host (get-card state target) (assoc card :zone [:discard])))}

    "Blue Level Clearance"
    {:effect (effect (gain :credit 5) (draw 2))}
@@ -1489,15 +1489,15 @@
    {:choices {:req #(and (= (:type %) "ICE") (not (:rezzed %)))}
     :msg (msg "rez " (:title target) " at no cost")
     :effect (effect (rez target {:no-cost true})
-                    (host (get-card state target) (get-card state (assoc card :zone [:discard]))))}
+                    (host (get-card state target) (assoc card :zone [:discard])))}

    "PAD Campaign"
    {:events {:corp-turn-begins {:msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}

    "Patch"
    {:choices {:req #(and (= (:type %) "ICE") (:rezzed %))}
-    :effect (effect (update-ice-strength (:host card))
-                    (host (get-card state target) (get-card state (assoc card :zone [:discard]))))
+    :effect (effect (host target (assoc card :zone [:discard]))
+                    (update-ice-strength (get-card state target)))
     :events {:pre-ice-strength {:req (req (= (:cid target) (:cid (:host card))))
                                 :effect (effect (ice-strength-bonus 2))}}}

@@ -2183,7 +2183,7 @@

    "Sub Boost"
    {:choices {:req #(and (= (:type %) "ICE") (:rezzed %))}
-    :effect (effect (host (get-card state target) (get-card state (assoc card :zone [:discard]))))}
+    :effect (effect (host target (assoc card :zone [:discard])))}

    "Subliminal Messaging"
    {:effect (effect (gain :credit 1)


improve struct conversion speed

improve struct conversion speed