Mark I - Generating Clojure code from Java code

--- src/clojure_fabric/core.clj
+++ src/clojure_fabric/core.clj
@@ -9,6 +9,8 @@
            java.lang.reflect.Modifier
            java.lang.reflect.Parameter
            java.nio.ByteBuffer
+           java.math.BigDecimal
+           java.math.BigInteger
            java.io.File
            java.util.Date
            ;;org.joda.time.DateTime
@@ -17,30 +19,7 @@
 )
   #_
   (:import clojure.lang.Reflector
-
-           [com.amazonaws
-            AmazonServiceException
-            ClientConfiguration]
-           [com.amazonaws.auth
-            AWSCredentials
-            AWSCredentialsProvider
-            AWSStaticCredentialsProvider
-            BasicAWSCredentials
-            BasicSessionCredentials
-            DefaultAWSCredentialsProviderChain]
-           com.amazonaws.auth.profile.ProfileCredentialsProvider
-
-           com.amazonaws.client.builder.AwsSyncClientBuilder
-           com.amazonaws.client.builder.AwsClientBuilder$EndpointConfiguration
-
-
-
            java.lang.reflect.InvocationTargetException
-
-
-
-           java.math.BigDecimal
-           java.math.BigInteger

            java.text.ParsePosition
            java.text.SimpleDateFormat
@@ -65,15 +44,18 @@
   "Returns a map with keys of idiomatic Clojure hyphenated keywords
   corresponding to the public Java method names of the class argument, vals are
   vectors of java.lang.reflect.Methods."
-  [client]
+  [client & [static?]]
   (->> (.getDeclaredMethods ^Class client)
-       (remove (fn [method]
-                 (let [mods (.getModifiers ^Method method)]
-                   (or (.isSynthetic ^Method method)
-                       (Modifier/isPrivate mods)
-                       (Modifier/isProtected mods)
-                       (Modifier/isStatic mods)))))
-       (group-by #(camel->keyword (.getName ^Method %)))))
+        (remove (fn [method]
+                  (let [mods (.getModifiers ^Method method)]
+                    (or (.isSynthetic ^Method method)
+                        (Modifier/isPrivate mods)
+                        (Modifier/isProtected mods)
+                        (not (Modifier/isPublic mods))
+                        (if static?
+                          (not (Modifier/isStatic mods))
+                          (Modifier/isStatic mods))))))
+        (group-by #(camel->keyword (.getName ^Method %)))))

 (defn- clojure-case
   "Similar to \"kabob case\" but the returned string is suitable for
@@ -159,35 +141,16 @@
                      arglist*))))))))

 (defn- args-from
-  ;; FIXME: Not true
-  "Function arguments take an optional first parameter map
-  of AWS credentials. Addtional parameters are either a map,
-  or seq of keys and values."
+  "Parameters are either a map, or seq of keys and values."
   [arg-seq]
-  (let [args (first arg-seq)]
-    (cond
-      (or (and (or (map? args)
-                   (map? (first args)))
-               (or (contains? (first args) :access-key)
-                   (contains? (first args) :endpoint)
-                   (contains? (first args) :profile)
-                   (contains? (first args) :client-config)))
-          ;;(instance? AWSCredentialsProvider (first args))
-          ;;(instance? AWSCredentials (first args))
-          )
-      {:args (if (-> args rest first map?)
-                 (if (-> args rest first empty?)
-                     {}
-                     (mapcat identity (-> args rest args-from :args)))
-                 (rest args))
-       :credential (if (map? (first args))
-                       (dissoc (first args) :client-config)
-                       (first args))
-       :client-config (:client-config (first args))}
-      (map? (first args))
-      {:args (let [m (mapcat identity (first args))]
-               (if (seq m) m {}))}
-      :default {:args args})))
+  (let [args (first arg-seq)
+        1st-arg (first args)]
+    (if (map? 1st-arg)
+      {:args (let [m (mapcat identity 1st-arg)]
+               (if (empty? m)
+                 {}
+                 m))}
+      {:args args})))

 (defn- types-match-args
   [args ^Method method]
@@ -293,18 +256,47 @@
    derived from the java.lang.reflect.Method(s). Overloaded
    methods will yield a variadic Clojure function."
   [client ns fname methods]
-  (intern ns (with-meta (symbol (name fname))
-               {:amazonica/client client
-                :amazonica/methods methods
-                :arglists (sort (map method-arglist methods))})
-          (fn [& args]
-            (if-let [method (best-method methods args)]
-              (if-not args
-                ((fn-call client method))
-                ((fn-call client method args)))
-              (throw (IllegalArgumentException.
-                      (format "Could not determine best method to invoke for %s using arguments %s"
-                              (name fname) args)))))))
+  (let [arglist (sort (map method-arglist methods))]
+   (intern ns (with-meta (symbol (name fname))
+                {:amazonica/client client
+                 :amazonica/methods methods
+                 :arglists arglist})
+           (fn [& args]
+             (if-let [method (best-method methods args)]
+               (if-not args
+                 ((fn-call client method))
+                 ((fn-call client method args)))
+               (throw (IllegalArgumentException.
+                       (format "Could not determine best method to invoke for %s using arguments %s"
+                               (name fname) args))))))))
+
+(defn generate-static-function
+  "Generate a wrapper function defintion"
+  [client fname methods]
+  (let [defn (symbol "defn")
+        class-prefix (str (.getName client) "/" )]
+   (with-out-str
+     (clojure.pprint/pprint
+      `(~defn ~(symbol (name fname))
+        ~@(map (fn [method args]
+                 `([~@args]
+                   (~(symbol (str class-prefix (.getName method))) ~@args)))
+               methods (map method-arglist methods)))))))
+
+(defn generate-function
+  "Generate a wrapper function defintion"
+  [client fname methods]
+  (let [defn (symbol "defn")
+        instance (symbol "instance")
+        type-hint (symbol (str "^" (.getName client)))]
+    (with-out-str
+      (clojure.pprint/pprint
+       `(~defn ~(symbol (name fname))
+         ~@(map (fn [method args]
+                  `([~type-hint ~instance ~@args]
+                    (. ~instance ~(symbol (.getName method)) ~@args)))
+                methods (map method-arglist methods)))))))
+

 (def ^:private camel->keyword2
   "Like [[camel->keyword]], but smarter about acronyms and concepts like iSCSI
@@ -314,6 +306,7 @@
    #(str/replace % #"(?i)iscsi" "ISCSI")
    #(str/replace % #"(?i)openid" "OPENID")))

+#_
 (defn set-client
   "Intern into the specified namespace all public methods
    from the Amazon*Client class as Clojure functions."
@@ -326,300 +319,326 @@
       (let [the-var2 (intern-function client ns fname2 methods)]
         (alter-meta! the-var assoc :amazonica/deprecated-in-favor-of the-var2)))))

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-(defonce ^:private credential (atom {}))
-
-(defonce ^:private client-config (atom {}))
-
-(def ^:dynamic ^:private *credentials* nil)
-
-(def ^:dynamic ^:private *client-config* nil)
-
-(def ^:dynamic ^:private *client-class* nil)
-
-(def ^:private date-format (atom "yyyy-MM-dd"))
-
-(def ^:private root-unwrapping (atom false))
-
-(defn- invoke-constructor
-  [class-name arg-vec]
-  (Reflector/invokeConstructor
+(defn generate-client
+  "Generate Clojure functions into the specified namespace all public methods
+   from the fabric-sdk-java class as Clojure functions."
+  [client]
+  (concat
+   ;; static functions
+   (for [[fname methods] (client-methods client true)
+         :let [fname2 (-> methods first .getName camel->keyword2)]]
+     (generate-static-function client
+                               (if (= fname fname2)
+                                 fname
+                                 fname2)
+                               methods))
+   ;; non-static functions
+   (for [[fname methods] (client-methods client)
+         :let [fname2 (-> methods first .getName camel->keyword2)]]
+     (generate-function client
+                        (if (= fname fname2)
+                          fname
+                          fname2)
+                        methods))))
+
+
+
+(def client (HFClient/createNewInstance))
+
+(comment
+
+
+
+
+
+
+
+
+
+
+
+
+
+ (defonce ^:private credential (atom {}))
+
+ (defonce ^:private client-config (atom {}))
+
+ (def ^:dynamic ^:private *credentials* nil)
+
+ (def ^:dynamic ^:private *client-config* nil)
+
+ (def ^:dynamic ^:private *client-class* nil)
+
+ (def ^:private date-format (atom "yyyy-MM-dd"))
+
+ (def ^:private root-unwrapping (atom false))
+
+ (defn- invoke-constructor
+   [class-name arg-vec]
+   (Reflector/invokeConstructor
     (Class/forName class-name)
     (into-array Object arg-vec)))

-(defn set-root-unwrapping!
-  "Enables JSON-like root unwrapping of singly keyed
+ (defn set-root-unwrapping!
+   "Enables JSON-like root unwrapping of singly keyed
   top level maps.
     {:root {:key 'foo' :name 'bar'}}
   would become
     {:key 'foo' :name 'bar'}"
-  [b]
-  (reset! root-unwrapping b))
-
-(defn set-date-format!
-  "Sets the java.text.SimpleDateFormat pattern to use
+   [b]
+   (reset! root-unwrapping b))
+
+ (defn set-date-format!
+   "Sets the java.text.SimpleDateFormat pattern to use
   for transparent coercion of Strings passed as
   arguments where java.util.Dates are required by the
   AWS api."
-  [df]
-  (reset! date-format df))
-
-
-
-(defn keys->cred
-  [access-key secret-key & [endpoint]]
-  (let [credential {:access-key access-key
-                    :secret-key secret-key}]
-    (if-not (empty? endpoint)
-      (merge credential {:endpoint endpoint})
-      credential)))
-
-(defn defcredential
-  "Specify the AWS access key, secret key and optional
+   [df]
+   (reset! date-format df))
+
+
+
+ (defn keys->cred
+   [access-key secret-key & [endpoint]]
+   (let [credential {:access-key access-key
+                     :secret-key secret-key}]
+     (if-not (empty? endpoint)
+       (merge credential {:endpoint endpoint})
+       credential)))
+
+ (defn defcredential
+   "Specify the AWS access key, secret key and optional
   endpoint to use on subsequent requests."
-  ([cred]
-   (reset! credential cred))
-  ([access-key secret-key & [endpoint]]
-   (defcredential (keys->cred access-key secret-key endpoint))))
-
-(defn defclientconfig
-  "Specify the default Client configuration to use on
+   ([cred]
+    (reset! credential cred))
+   ([access-key secret-key & [endpoint]]
+    (defcredential (keys->cred access-key secret-key endpoint))))
+
+ (defn defclientconfig
+   "Specify the default Client configuration to use on
   subsequent requests."
-  [config]
-  (reset! client-config config))
-
-(defmacro with-credential
-  "Per invocation binding of credentials for ad-hoc
+   [config]
+   (reset! client-config config))
+
+ (defmacro with-credential
+   "Per invocation binding of credentials for ad-hoc
   service calls using alternate user/password combos
   (and endpoints)."
-  [cred & body]
-  `(binding [*credentials*
-             (let [cred# ~cred]
-               (if (sequential? cred#)
-                 (apply keys->cred cred#)
-                 cred#))]
-    (do ~@body)))
-
-(defmacro with-client-config
-  "Per invocation binding of client-config for ad-hoc
+   [cred & body]
+   `(binding [*credentials*
+              (let [cred# ~cred]
+                (if (sequential? cred#)
+                  (apply keys->cred cred#)
+                  cred#))]
+      (do ~@body)))
+
+ (defmacro with-client-config
+   "Per invocation binding of client-config for ad-hoc
   service calls using alternate client configuration."
-  [config & body]
-  `(binding [*client-config* ~config]
-     (do ~@body)))
-
-(defn- builder ^AwsSyncClientBuilder [^Class clazz]
-  (let [^Method method (.getMethod clazz "builder" (make-array Class 0))]
-    (.invoke method clazz (make-array Object 0))))
-
-(declare set-fields)
-
-(defn- build-client [^Class clazz credentials configuration raw-creds options]
-  (let [builder (builder clazz)
-        _ (set-fields builder options)
-        builder (if credentials (.withCredentials builder credentials) builder)
-        builder (if configuration (.withClientConfiguration builder configuration) builder)
-        endpoint (or (:endpoint raw-creds) (System/getenv "AWS_DEFAULT_REGION"))
-        builder (if endpoint
-                  (if (.startsWith endpoint "http")
-                      (.withEndpointConfiguration
-                        builder
-                        (AwsClientBuilder$EndpointConfiguration. endpoint nil))
-                      (.withRegion builder endpoint))
-                  builder)]
-    (.build builder)))
-
-(defn- create-client
-  [clazz credentials configuration raw-creds options]
-  (if (= (.getSimpleName clazz) "TransferManager")
-    (invoke-constructor
+   [config & body]
+   `(binding [*client-config* ~config]
+      (do ~@body)))
+
+ (defn- builder ^AwsSyncClientBuilder [^Class clazz]
+   (let [^Method method (.getMethod clazz "builder" (make-array Class 0))]
+     (.invoke method clazz (make-array Object 0))))
+
+ (declare set-fields)
+
+ (defn- build-client [^Class clazz credentials configuration raw-creds options]
+   (let [builder (builder clazz)
+         _ (set-fields builder options)
+         builder (if credentials (.withCredentials builder credentials) builder)
+         builder (if configuration (.withClientConfiguration builder configuration) builder)
+         endpoint (or (:endpoint raw-creds) (System/getenv "AWS_DEFAULT_REGION"))
+         builder (if endpoint
+                   (if (.startsWith endpoint "http")
+                     (.withEndpointConfiguration
+                      builder
+                      (AwsClientBuilder$EndpointConfiguration. endpoint nil))
+                     (.withRegion builder endpoint))
+                   builder)]
+     (.build builder)))
+
+ (defn- create-client
+   [clazz credentials configuration raw-creds options]
+   (if (= (.getSimpleName clazz) "TransferManager")
+     (invoke-constructor
       "com.amazonaws.services.s3.transfer.TransferManager"
       [(create-client (Class/forName "com.amazonaws.services.s3.AmazonS3Client")
                       credentials
                       configuration
                       raw-creds {})])
-    (build-client clazz credentials configuration raw-creds options)))
-
-(defn get-credentials
-  [credentials]
-  (cond
-    (instance? AWSCredentialsProvider credentials)
-      credentials
-    (instance? AWSCredentials credentials)
-      (AWSStaticCredentialsProvider. credentials)
-    (and (associative? credentials)
-         (contains? credentials :session-token))
-    (AWSStaticCredentialsProvider.
+     (build-client clazz credentials configuration raw-creds options)))
+
+ (defn get-credentials
+   [credentials]
+   (cond
+     (instance? AWSCredentialsProvider credentials)
+     credentials
+     (instance? AWSCredentials credentials)
+     (AWSStaticCredentialsProvider. credentials)
+     (and (associative? credentials)
+          (contains? credentials :session-token))
+     (AWSStaticCredentialsProvider.
       (BasicSessionCredentials.
-        (:access-key credentials)
-        (:secret-key credentials)
-        (:session-token credentials)))
-    (and (associative? credentials)
-         (contains? credentials :access-key))
-    (AWSStaticCredentialsProvider.
+       (:access-key credentials)
+       (:secret-key credentials)
+       (:session-token credentials)))
+     (and (associative? credentials)
+          (contains? credentials :access-key))
+     (AWSStaticCredentialsProvider.
       (BasicAWSCredentials.
-        (:access-key credentials)
-        (:secret-key credentials)))
-    (and (associative? credentials)
-         (contains? credentials :profile))
-    (ProfileCredentialsProvider.
-        (:profile credentials))
-    (and (associative? credentials)
-         (instance? AWSCredentialsProvider (:cred credentials)))
-    (:cred credentials)
-    :else
-    (DefaultAWSCredentialsProviderChain.)))
-
-(defn parse-args
-  "Legacy support means credentials may or may not be passed
+       (:access-key credentials)
+       (:secret-key credentials)))
+     (and (associative? credentials)
+          (contains? credentials :profile))
+     (ProfileCredentialsProvider.
+      (:profile credentials))
+     (and (associative? credentials)
+          (instance? AWSCredentialsProvider (:cred credentials)))
+     (:cred credentials)
+     :else
+     (DefaultAWSCredentialsProviderChain.)))
+
+ (defn parse-args
+   "Legacy support means credentials may or may not be passed
    as the first argument."
-  [cred args]
-  (if (and (instance? AWSCredentialsProvider (get-credentials cred))
-           (not (instance? AWSCredentialsProvider cred))
-           (nil? (:endpoint cred)))
-    {:args (conj args cred)}
-    {:args args :cred cred}))
-
-(declare create-bean)
-
-(defn- get-client-configuration
-  [configuration]
-  (when (associative? configuration)
-    (create-bean ClientConfiguration configuration)))
-
-(defn- set-endpoint!
-  [client credentials]
-  (when-let [endpoint (or (:endpoint credentials)
-                          (System/getenv "AWS_DEFAULT_REGION"))]
-    (if (contains? (fmap #(-> % str/upper-case (str/replace "_" ""))
-                         (apply hash-set (seq (Regions/values))))
-                   (-> (str/upper-case endpoint)
-                       (str/replace "-" "")))
-        (try
-          (->> (-> (str/upper-case endpoint)
-                   (str/replace "-" "_"))
-               Regions/valueOf
-               Region/getRegion
-               (.setRegion client))
-          (catch NoSuchMethodException e
-            (println e)))
-        (.setEndpoint client endpoint))))
-
-(defn encryption-client*
-  [encryption credentials configuration]
-  (let [creds     (get-credentials credentials)
-        config    (get-client-configuration configuration)
-        key       (or (:secret-key encryption)
-                      (:key-pair encryption))
-        crypto    (invoke-constructor
+   [cred args]
+   (if (and (instance? AWSCredentialsProvider (get-credentials cred))
+            (not (instance? AWSCredentialsProvider cred))
+            (nil? (:endpoint cred)))
+     {:args (conj args cred)}
+     {:args args :cred cred}))
+
+ (declare create-bean)
+
+ (defn- get-client-configuration
+   [configuration]
+   (when (associative? configuration)
+     (create-bean ClientConfiguration configuration)))
+
+ (defn- set-endpoint!
+   [client credentials]
+   (when-let [endpoint (or (:endpoint credentials)
+                           (System/getenv "AWS_DEFAULT_REGION"))]
+     (if (contains? (fmap #(-> % str/upper-case (str/replace "_" ""))
+                          (apply hash-set (seq (Regions/values))))
+                    (-> (str/upper-case endpoint)
+                        (str/replace "-" "")))
+       (try
+         (->> (-> (str/upper-case endpoint)
+                  (str/replace "-" "_"))
+              Regions/valueOf
+              Region/getRegion
+              (.setRegion client))
+         (catch NoSuchMethodException e
+           (println e)))
+       (.setEndpoint client endpoint))))
+
+ (defn encryption-client*
+   [encryption credentials configuration]
+   (let [creds     (get-credentials credentials)
+         config    (get-client-configuration configuration)
+         key       (or (:secret-key encryption)
+                       (:key-pair encryption))
+         crypto    (invoke-constructor
                     "com.amazonaws.services.s3.model.CryptoConfiguration" [])
-        em        (invoke-constructor
+         em        (invoke-constructor
                     "com.amazonaws.services.s3.model.EncryptionMaterials"
                     [key])
-        materials (invoke-constructor
+         materials (invoke-constructor
                     "com.amazonaws.services.s3.model.StaticEncryptionMaterialsProvider"
                     [em])
-        _         (if-let [provider (:provider encryption)]
-                    (.withCryptoProvider crypto provider))
-        client    (if config
-                      (invoke-constructor
-                        "com.amazonaws.services.s3.AmazonS3EncryptionClient"
-                        [creds materials config crypto])
-                      (invoke-constructor
-                        "com.amazonaws.services.s3.AmazonS3EncryptionClient"
-                        [creds materials crypto]))]
-    (set-endpoint! client credentials)
-    client))
-
-(swap! client-config assoc :encryption-client-fn (memoize encryption-client*))
-
-(defn amazon-client*
-  [clazz credentials configuration]
-  (let [aws-creds  (get-credentials credentials)
-        aws-config (get-client-configuration configuration)
-        client     (create-client clazz aws-creds aws-config credentials configuration)]
-    client))
-
-(swap! client-config assoc :amazon-client-fn (memoize amazon-client*))
-
-
-
-
-
-
-
-(defn- keyword->camel
-  [kw]
-  (let [n (name kw)
-        m (.replace n "?" "")]
-    (->> (str/split m #"\-")
-         (fmap str/capitalize)
-         str/join)))
-
-(defn- aws-package?
-  [clazz]
-  (->> (.getName clazz)
-       (re-find #"com\.amazonaws\.services")
-       some?))
-
-
-
-
-
-(defn to-enum
-  "Case-insensitive resolution of Enum types by String."
-  [type value]
-  (some
+         _         (if-let [provider (:provider encryption)]
+                     (.withCryptoProvider crypto provider))
+         client    (if config
+                     (invoke-constructor
+                      "com.amazonaws.services.s3.AmazonS3EncryptionClient"
+                      [creds materials config crypto])
+                     (invoke-constructor
+                      "com.amazonaws.services.s3.AmazonS3EncryptionClient"
+                      [creds materials crypto]))]
+     (set-endpoint! client credentials)
+     client))
+
+ (swap! client-config assoc :encryption-client-fn (memoize encryption-client*))
+
+ (defn amazon-client*
+   [clazz credentials configuration]
+   (let [aws-creds  (get-credentials credentials)
+         aws-config (get-client-configuration configuration)
+         client     (create-client clazz aws-creds aws-config credentials configuration)]
+     client))
+
+ (swap! client-config assoc :amazon-client-fn (memoize amazon-client*))
+
+
+
+
+
+
+
+ (defn- keyword->camel
+   [kw]
+   (let [n (name kw)
+         m (.replace n "?" "")]
+     (->> (str/split m #"\-")
+          (fmap str/capitalize)
+          str/join)))
+
+ (defn- aws-package?
+   [clazz]
+   (->> (.getName clazz)
+        (re-find #"com\.amazonaws\.services")
+        some?))
+
+
+
+
+
+ (defn to-enum
+   "Case-insensitive resolution of Enum types by String."
+   [type value]
+   (some
     #(if (and
-           (not (nil? (.toString %))) ; some aws enums return nil!
-           (= (str/upper-case value)
+          (not (nil? (.toString %)))    ; some aws enums return nil!
+          (= (str/upper-case value)
              (str/upper-case (.toString %))))
-      %)
+       %)
     (-> type
         (.getDeclaredMethod "values" (make-array Class 0))
         (.invoke type (make-array Object 0)))))

-(defn register-coercions
-  "Accepts key/value pairs of class/function, which defines
+ (defn register-coercions
+   "Accepts key/value pairs of class/function, which defines
   how data will be converted to the appropriate type
   required by the AWS Amazon*Client Java method."
-  [& {:as coercion}]
-  (swap! coercions merge coercion))
-
-(defn coerce-value
-  "Coerces the supplied stringvalue to the required type as
+   [& {:as coercion}]
+   (swap! coercions merge coercion))
+
+ (defn coerce-value
+   "Coerces the supplied stringvalue to the required type as
   defined by the AWS method signature. String or keyword
   conversion to Enum types (e.g. via valueOf()) is supported."
-  [value type]
-  (let [value (if (keyword? value) (name value) value)]
-    (if-not (instance? type value)
-      (if (= java.lang.Enum (.getSuperclass type))
-        (to-enum type value)
-        (if-let [coercion (@coercions (if (.isPrimitive type)
-                                        (str type)
-                                        type))]
-          (coercion value)
-          (throw (IllegalArgumentException.
+   [value type]
+   (let [value (if (keyword? value) (name value) value)]
+     (if-not (instance? type value)
+       (if (= java.lang.Enum (.getSuperclass type))
+         (to-enum type value)
+         (if-let [coercion (@coercions (if (.isPrimitive type)
+                                         (str type)
+                                         type))]
+           (coercion value)
+           (throw (IllegalArgumentException.
                    (format "No coercion is available to turn %s into an object of type %s"
                            value type)))))
-      value)))
-
-(defn- default-value
-  [class-name]
-  (get
+       value)))
+
+ (defn- default-value
+   [class-name]
+   (get
     {"boolean" false
      "double" (double 0.0)
      "float" (float 0.0)
@@ -627,82 +646,82 @@
      "int" (int 0)}
     class-name))

-(defn- constructor-args
-  [ctor]
-  (let [types (.getParameterTypes ctor)]
-    (if (= 0 (count types))
-      (make-array Object 0)
-      (into-array Object
-        (map
-          (comp default-value str)
-          (seq types))))))
-
-(defn best-constructor
-  "Prefer no-arg ctor if one exists, else the first found."
-  [clazz]
-  {:pre [clazz]}
-  (let [ctors (.getConstructors clazz)]
-    (or
+ (defn- constructor-args
+   [ctor]
+   (let [types (.getParameterTypes ctor)]
+     (if (= 0 (count types))
+       (make-array Object 0)
+       (into-array Object
+                   (map
+                    (comp default-value str)
+                    (seq types))))))
+
+ (defn best-constructor
+   "Prefer no-arg ctor if one exists, else the first found."
+   [clazz]
+   {:pre [clazz]}
+   (let [ctors (.getConstructors clazz)]
+     (or
       (some
-        #(if (= 0 (count (.getParameterTypes %)))
+       #(if (= 0 (count (.getParameterTypes %)))
           %
           nil)
-        ctors)
+       ctors)
       (first (sort-by
-               (fn [ctor]
-                 (some aws-package? (.getParameterTypes ctor)))
-               ctors)))))
-
-(defn- new-instance
-  "Create a new instance of a Java bean. S3 neccessitates
+              (fn [ctor]
+                (some aws-package? (.getParameterTypes ctor)))
+              ctors)))))
+
+ (defn- new-instance
+   "Create a new instance of a Java bean. S3 neccessitates
   the check for contructor args here, as the rest of the
   AWS api contains strictly no-arg ctor JavaBeans."
-  [clazz]
-  {:pre [clazz]}
-  (let [ctor (best-constructor clazz)
-        arr  (constructor-args ctor)]
-    (.newInstance ctor arr)))
-
-(defn- unwind-types
-  [depth param]
-  (if (instance? ParameterizedType param)
-      (let [f (partial unwind-types (inc depth))
-            types (-> param .getActualTypeArguments)
-            t (-> types last f)]
-        (if (and (instance? ParameterizedType (last types))
-                 (.contains (-> types last str) "java.util")
-                 (.contains (-> types last str) "java.lang"))
-          {:type [(-> types last .getRawType)]
-           :depth depth}
-          t))
-      {:type [param]
-       :depth depth}))
-
-(defn- paramter-types
-  [method]
-  (let [types (seq (.getGenericParameterTypes method))
-        param (last types)
-        rval  {:generic types}]
-    (if (instance? ParameterizedType param)
-        (let [t (unwind-types 1 param)]
-          (merge rval
-                 {:actual (:type t)
-                  :depth  (:depth t)}))
-        rval)))
-
-(defn- normalized-name
-  [method-name]
-  (-> (name method-name)
-      (.replaceFirst
+   [clazz]
+   {:pre [clazz]}
+   (let [ctor (best-constructor clazz)
+         arr  (constructor-args ctor)]
+     (.newInstance ctor arr)))
+
+ (defn- unwind-types
+   [depth param]
+   (if (instance? ParameterizedType param)
+     (let [f (partial unwind-types (inc depth))
+           types (-> param .getActualTypeArguments)
+           t (-> types last f)]
+       (if (and (instance? ParameterizedType (last types))
+                (.contains (-> types last str) "java.util")
+                (.contains (-> types last str) "java.lang"))
+         {:type [(-> types last .getRawType)]
+          :depth depth}
+         t))
+     {:type [param]
+      :depth depth}))
+
+ (defn- paramter-types
+   [method]
+   (let [types (seq (.getGenericParameterTypes method))
+         param (last types)
+         rval  {:generic types}]
+     (if (instance? ParameterizedType param)
+       (let [t (unwind-types 1 param)]
+         (merge rval
+                {:actual (:type t)
+                 :depth  (:depth t)}))
+       rval)))
+
+ (defn- normalized-name
+   [method-name]
+   (-> (name method-name)
+       (.replaceFirst
         (case (.substring method-name 0 3)
           "get" "get"
           "set" "set"
           "default")
-      "")
-      (.toLowerCase)))
-
-(defn- matches?
-  "We exclude any mutators of the bean which
+        "")
+       (.toLowerCase)))
+
+ (defn- matches?
+   "We exclude any mutators of the bean which
    expect a java.util.Map$Entry as the first
    argument, as we won't be dealing in these
    from Clojure. Specifically, this is meant
@@ -710,311 +729,311 @@
    in the DynamoDBV2Client.
    http://docs.aws.amazon.com/AWSJavaSDK/latest/javadoc/com/amazonaws/services/dynamodbv2/model/DeleteItemRequest.html#setKey(java.util.Map.Entry, java.util.Map.Entry)
    http://docs.aws.amazon.com/AWSJavaSDK/latest/javadoc/com/amazonaws/services/dynamodbv2/model/GetItemRequest.html#setKey(java.util.Map.Entry, java.util.Map.Entry)"
-  [method name value]
-  (let [args (.getParameterTypes method)]
-    (and (= name (normalized-name (.getName method)))
-         (if (empty? value)
-             (= 0 (count args))
-             (and (< 0 (count args))
-                  (or (= (count args) (count (flatten value)))
-                      (and (coll? value)
-                           (= 1 (count args))
-                           (or (contains? @coercions (first args))
-                               (.isArray (first args))
-                               (and (.getPackage (first args))
-                                    (.startsWith
-                                      (.getName (.getPackage (first args)))
-                                      "java.util")))))
-                  (not (and (= 2 (count args))
-                            (every? (partial = java.util.Map$Entry)
-                                    args))))))))
-
-(defn- accessor-methods
-  [class-methods name value]
-  (reduce
+   [method name value]
+   (let [args (.getParameterTypes method)]
+     (and (= name (normalized-name (.getName method)))
+          (if (empty? value)
+            (= 0 (count args))
+            (and (< 0 (count args))
+                 (or (= (count args) (count (flatten value)))
+                     (and (coll? value)
+                          (= 1 (count args))
+                          (or (contains? @coercions (first args))
+                              (.isArray (first args))
+                              (and (.getPackage (first args))
+                                   (.startsWith
+                                    (.getName (.getPackage (first args)))
+                                    "java.util")))))
+                 (not (and (= 2 (count args))
+                           (every? (partial = java.util.Map$Entry)
+                                   args))))))))
+
+ (defn- accessor-methods
+   [class-methods name value]
+   (reduce
     #(if (matches? %2 name value)
-      (conj %1 %2)
-      %1)
+       (conj %1 %2)
+       %1)
     []
     class-methods))

-(defn- find-methods
-  [pojo k & v]
-  (-> (.getClass pojo)
-      (.getMethods)
-      (accessor-methods
+ (defn- find-methods
+   [pojo k & v]
+   (-> (.getClass pojo)
+       (.getMethods)
+       (accessor-methods
         (.toLowerCase (keyword->camel k))
         v)))

-(defn to-java-coll
-  "Need this only because S3 methods actually try to
+ (defn to-java-coll
+   "Need this only because S3 methods actually try to
    mutate (e.g. sort) collections passed to them."
-  [col]
-  (cond
-    (map? col)
-      (doto
-        (java.util.HashMap.)
-        (.putAll col))
-    (set? col)
-      (java.util.HashSet. col)
-    (or (list? col) (vector? col))
-      (java.util.ArrayList. col)))
-
-(defn- invoke
-  [pojo method v]
-  (.invoke method pojo
-    (into-array
-      ;; misbehaving S3Client mutates the coll
-      (if (and (coll? v)
-               (not (nil? *client-class*))
-               (= "AmazonS3Client" (.getSimpleName *client-class*)))
-        (if (and (> (count (.getParameterTypes method)) 1)
-                 (sequential? v))
-          (to-java-coll v)
-          [(to-java-coll v)])
-          [v])))
-  true)
-
-(defn kw->str [k]
-  (if (keyword? k) (name k) k))
-
-(defn- populate
-  [types key props]
-  (let [type (-> types key last)]
-    (assert type (str "Bad data type - there is no " key " in " types))
-    (if (contains? @coercions type)
-      (coerce-value props type)
-      (set-fields (new-instance type) props))))
-
-(defn- unmarshall
-  "Transform Clojure data to the required Java objects."
-  [types col]
-  (let [type (last (or (:actual types)
-                       (:generic types)))
-        pp   (partial populate types :actual)]
-    (try
-      (if (aws-package? type)
-       (if (map? col)
-         (if (contains? types :actual)
-           (if (< (:depth types) 3)
-             (apply assoc {}
-                    (interleave (fmap kw->str (apply vector (keys col)))
-                                (fmap pp (apply vector (vals col)))))
-             (apply assoc {}
-                    (interleave (fmap kw->str (apply vector (keys col)))
-                                [(fmap #(populate {:generic [type]}
-                                                  :generic
-                                                  %)
-                                       (first (apply vector (vals col))))])))
-           (populate types :generic col))
+   [col]
+   (cond
+     (map? col)
+     (doto
+         (java.util.HashMap.)
+         (.putAll col))
+     (set? col)
+     (java.util.HashSet. col)
+     (or (list? col) (vector? col))
+     (java.util.ArrayList. col)))
+
+ (defn- invoke
+   [pojo method v]
+   (.invoke method pojo
+            (into-array
+             ;; misbehaving S3Client mutates the coll
+             (if (and (coll? v)
+                      (not (nil? *client-class*))
+                      (= "AmazonS3Client" (.getSimpleName *client-class*)))
+               (if (and (> (count (.getParameterTypes method)) 1)
+                        (sequential? v))
+                 (to-java-coll v)
+                 [(to-java-coll v)])
+               [v])))
+   true)
+
+ (defn kw->str [k]
+   (if (keyword? k) (name k) k))
+
+ (defn- populate
+   [types key props]
+   (let [type (-> types key last)]
+     (assert type (str "Bad data type - there is no " key " in " types))
+     (if (contains? @coercions type)
+       (coerce-value props type)
+       (set-fields (new-instance type) props))))
+
+ (defn- unmarshall
+   "Transform Clojure data to the required Java objects."
+   [types col]
+   (let [type (last (or (:actual types)
+                        (:generic types)))
+         pp   (partial populate types :actual)]
+     (try
+       (if (aws-package? type)
+         (if (map? col)
+           (if (contains? types :actual)
+             (if (< (:depth types) 3)
+               (apply assoc {}
+                      (interleave (fmap kw->str (apply vector (keys col)))
+                                  (fmap pp (apply vector (vals col)))))
+               (apply assoc {}
+                      (interleave (fmap kw->str (apply vector (keys col)))
+                                  [(fmap #(populate {:generic [type]}
+                                                    :generic
+                                                    %)
+                                         (first (apply vector (vals col))))])))
+             (populate types :generic col))
+           (if (and (contains? types :actual)
+                    (= (:depth types) 3))
+             (fmap #(fmap pp %) col)
+             (fmap pp col)))
          (if (and (contains? types :actual)
-                  (= (:depth types) 3))
-           (fmap #(fmap pp %) col)
-           (fmap pp col)))
-       (if (and (contains? types :actual)
-                (aws-package? type))
-         (fmap pp col)
-         (fmap #(coerce-value % type) col)))
-      (catch Throwable e
-        (throw (RuntimeException. (str
+                  (aws-package? type))
+           (fmap pp col)
+           (fmap #(coerce-value % type) col)))
+       (catch Throwable e
+         (throw (RuntimeException. (str
                                     "Failed to create an instance of "
                                     (.getName type)
                                     " from " col
                                     " due to " e
                                     ". Make sure the data matches an existing constructor and setters.")))))))

-(defn- invoke-method
-  [pojo v method]
-  (let [f       (partial invoke pojo method)
-        types   (paramter-types method)
-        generic (last (:generic types))]
-    (if (and
+ (defn- invoke-method
+   [pojo v method]
+   (let [f       (partial invoke pojo method)
+         types   (paramter-types method)
+         generic (last (:generic types))]
+     (if (and
           (coll? v)
           (not (contains? @coercions generic)))
-      (f (unmarshall types v))
-      (if (instance? generic v)
-        (f v)
-        (f (coerce-value v generic))))))
-
-(defn set-fields
-  "Returns the populated AWS *Request bean with 'args' as
+       (f (unmarshall types v))
+       (if (instance? generic v)
+         (f v)
+         (f (coerce-value v generic))))))
+
+ (defn set-fields
+   "Returns the populated AWS *Request bean with 'args' as
    the values. args is a map with keywords as keys and any
    type values. Complex values will be recursively resolved
    to the corresponding method calls on the object graph."
-  [pojo args]
-  (doseq [[k v] args]
-    (try
-      (->> (find-methods pojo k v)
-           (some (partial invoke-method pojo v)))
-      (catch Throwable e
-        (throw (ex-info
+   [pojo args]
+   (doseq [[k v] args]
+     (try
+       (->> (find-methods pojo k v)
+            (some (partial invoke-method pojo v)))
+       (catch Throwable e
+         (throw (ex-info
                  (str "Error setting " k ": " (.getMessage e) ". Perhaps the value isn't compatible with the setter?")
                  {:property k, :value v}
                  e)))))
-  pojo)
-
-(defn- create-bean
-  [clazz args]
-  (-> clazz new-instance (set-fields args)))
-
-(defn- create-request-bean
-  "Create a new instance of an AWS *Request style Java
+   pojo)
+
+ (defn- create-bean
+   [clazz args]
+   (-> clazz new-instance (set-fields args)))
+
+ (defn- create-request-bean
+   "Create a new instance of an AWS *Request style Java
    bean passed as the argument to a method call on the
    Amazon*Client class. (Note that we assume all AWS
    service calls take at most a single argument.)"
-  [method args]
-  (let [clazz (first (.getParameterTypes method))]
-    (if (contains? @coercions clazz)
-        (coerce-value (into {} args) clazz)
-        (create-bean clazz args))))
-
-
-(defprotocol IMarshall
-  "Defines the contract for converting Java types to Clojure
+   [method args]
+   (let [clazz (first (.getParameterTypes method))]
+     (if (contains? @coercions clazz)
+       (coerce-value (into {} args) clazz)
+       (create-bean clazz args))))
+
+
+ (defprotocol IMarshall
+   "Defines the contract for converting Java types to Clojure
   data. All return values from AWS service calls are
   marshalled. As such, the AWS service-specific namespaces
   will frequently need to implement this protocol in order
   to provide convenient data representations. See also the
   register-coercions function for coercing Clojure data to
   Java types."
-  (marshall [obj]))
-
-(defn- getter?
-  [method]
-  (let [name (.getName method)
-        type (.getName (.getReturnType method))]
-    (or (and
+   (marshall [obj]))
+
+ (defn- getter?
+   [method]
+   (let [name (.getName method)
+         type (.getName (.getReturnType method))]
+     (or (and
           (.startsWith name "get")
           (= 0 (count (.getParameterTypes method))))
-        (and
+         (and
           (.startsWith name "is")
           (= "boolean" type)))))

-(defn accessors
-  "Returns a vector of getters or setters for the class."
-  [clazz getters?]
-  (reduce
+ (defn accessors
+   "Returns a vector of getters or setters for the class."
+   [clazz getters?]
+   (reduce
     #(if (or
-           (and getters? (getter? %2))
-           (and (not getters?)
-                (.startsWith (.getName %2) "set")))
-      (conj % %2)
-      %)
+          (and getters? (getter? %2))
+          (and (not getters?)
+               (.startsWith (.getName %2) "set")))
+       (conj % %2)
+       %)
     []
     (.getDeclaredMethods clazz)))

-(defn- prop->name
-  [method]
-  (let [name (.getName method)]
-    (if (.startsWith name "is")
-      (str (.substring name 2) "?")
-      (.substring name 3))))
-
-(defn get-fields
-  "Returns a map of all non-null values returned by
+ (defn- prop->name
+   [method]
+   (let [name (.getName method)]
+     (if (.startsWith name "is")
+       (str (.substring name 2) "?")
+       (.substring name 3))))
+
+ (defn get-fields
+   "Returns a map of all non-null values returned by
   invoking all public getters on the specified object."
-  [obj]
-  (let [no-arg (make-array Object 0)]
-    (into {}
-      (for [m (accessors (class obj) true)]
-        (let [r (marshall (.invoke m obj no-arg))]
-          (if-not (nil? r)
-            (hash-map
-              (camel->keyword (prop->name m))
-              r)))))))
-
-(extend-protocol IMarshall
-  nil
-  (marshall [obj] nil)
-
-  java.util.Map
-  (marshall [obj]
-    (if-not (empty? obj)
-      (apply assoc {}
-        (interleave
-          (fmap #(if (string? %) (keyword %) %)
-                (apply vector (keys obj)))
-          (fmap marshall
-                (apply vector (vals obj)))))))
-
-  java.util.Collection
-  (marshall [obj]
-    (if (instance? clojure.lang.IPersistentSet obj)
-      obj
-      (fmap marshall (apply vector obj))))
-
-  java.util.Date
-  (marshall [obj] (DateTime. (.getTime obj)))
-
-  ; `false` boolean objects (i.e. (Boolean. false)) come out of e.g.
-  ; .doesBucketExist, which wreak havoc on Clojure truthiness
-  Boolean
-  (marshall [obj] (when-not (nil? obj) (.booleanValue obj)))
-
-  Object
-  (marshall [obj]
-    (if (aws-package? (class obj))
-        (get-fields obj)
-        obj)))
-
-(defn- use-aws-request-bean?
-  [method args]
-  (let [types (.getParameterTypes method)]
-    (and (or (map? args) (< 1 (count args)))
-         (< 0 (count types))
-         (or (map? args)
-             (and
-                (or (and
-                      (even? (count args))
-                      (not= java.io.File (last types)))
-                    (and
-                      (odd? (count args))
-                      (= java.io.File (last types)))) ; s3 getObject() support
-                (some keyword? args)))
-         (or (aws-package? (first types))
-             (and (aws-package? (last types))
-                  (not (< (count types) (count args))))))))
-
-(defn- prepare-args
-  [method args]
-  (let [types (.getParameterTypes method)
-        num   (count types)]
-    (if (and (empty? args) (= 0 num))
-      (into-array Object args)
-      (if (= num (count args))
-        (into-array Object
-          (map #(if (and (aws-package? %2) (seq (.getConstructors %2)))
-                  ; must be a concrete, instantiatable class
-                  (if (contains? @coercions %2)
-                      (coerce-value % %2)
-                      (create-bean %2 %))
-                  (coerce-value % %2))
-               (vec args)
-               types))
-        (if (use-aws-request-bean? method args)
-          (cond
-            (= 1 num)
-            (into-array Object
-                        [(create-request-bean
-                            method
-                            (seq (apply hash-map args)))])
-            (and (aws-package? (first types))
-                 (= 2 num)
-                 (= File (last types)))
-            (into-array Object
-                        [(create-request-bean
-                            method
-                            (seq (apply hash-map (butlast args))))
-                         (last args)])))))))
-
-
-
-
-(defn transfer-manager*
-  [credential client-config crypto]
-  (let [encryption-client (:encryption-client-fn client-config)
-        amazon-client (:amazon-client-fn client-config)]
-    (invoke-constructor
+   [obj]
+   (let [no-arg (make-array Object 0)]
+     (into {}
+           (for [m (accessors (class obj) true)]
+             (let [r (marshall (.invoke m obj no-arg))]
+               (if-not (nil? r)
+                 (hash-map
+                  (camel->keyword (prop->name m))
+                  r)))))))
+
+ (extend-protocol IMarshall
+   nil
+   (marshall [obj] nil)
+
+   java.util.Map
+   (marshall [obj]
+     (if-not (empty? obj)
+       (apply assoc {}
+              (interleave
+               (fmap #(if (string? %) (keyword %) %)
+                     (apply vector (keys obj)))
+               (fmap marshall
+                     (apply vector (vals obj)))))))
+
+   java.util.Collection
+   (marshall [obj]
+     (if (instance? clojure.lang.IPersistentSet obj)
+       obj
+       (fmap marshall (apply vector obj))))
+
+   java.util.Date
+   (marshall [obj] (DateTime. (.getTime obj)))
+
+                                        ; `false` boolean objects (i.e. (Boolean. false)) come out of e.g.
+                                        ; .doesBucketExist, which wreak havoc on Clojure truthiness
+   Boolean
+   (marshall [obj] (when-not (nil? obj) (.booleanValue obj)))
+
+   Object
+   (marshall [obj]
+     (if (aws-package? (class obj))
+       (get-fields obj)
+       obj)))
+
+ (defn- use-aws-request-bean?
+   [method args]
+   (let [types (.getParameterTypes method)]
+     (and (or (map? args) (< 1 (count args)))
+          (< 0 (count types))
+          (or (map? args)
+              (and
+               (or (and
+                    (even? (count args))
+                    (not= java.io.File (last types)))
+                   (and
+                    (odd? (count args))
+                    (= java.io.File (last types)))) ; s3 getObject() support
+               (some keyword? args)))
+          (or (aws-package? (first types))
+              (and (aws-package? (last types))
+                   (not (< (count types) (count args))))))))
+
+ (defn- prepare-args
+   [method args]
+   (let [types (.getParameterTypes method)
+         num   (count types)]
+     (if (and (empty? args) (= 0 num))
+       (into-array Object args)
+       (if (= num (count args))
+         (into-array Object
+                     (map #(if (and (aws-package? %2) (seq (.getConstructors %2)))
+                                        ; must be a concrete, instantiatable class
+                             (if (contains? @coercions %2)
+                               (coerce-value % %2)
+                               (create-bean %2 %))
+                             (coerce-value % %2))
+                          (vec args)
+                          types))
+         (if (use-aws-request-bean? method args)
+           (cond
+             (= 1 num)
+             (into-array Object
+                         [(create-request-bean
+                           method
+                           (seq (apply hash-map args)))])
+             (and (aws-package? (first types))
+                  (= 2 num)
+                  (= File (last types)))
+             (into-array Object
+                         [(create-request-bean
+                           method
+                           (seq (apply hash-map (butlast args))))
+                          (last args)])))))))
+
+
+
+
+ (defn transfer-manager*
+   [credential client-config crypto]
+   (let [encryption-client (:encryption-client-fn client-config)
+         amazon-client (:amazon-client-fn client-config)]
+     (invoke-constructor
       "com.amazonaws.services.s3.transfer.TransferManager"
       (if crypto
         [(encryption-client crypto credential client-config)]
@@ -1022,73 +1041,74 @@
                         credential
                         client-config)]))))

-(swap! client-config assoc :transfer-manager-fn (memoize transfer-manager*))
-
-(defn candidate-client
-  [clazz args]
-  (let [cred-bound (or *credentials* (:credential args))
-        credential (if (map? cred-bound)
-                             (merge @credential cred-bound)
-                             (or cred-bound @credential))
-        config-bound (or *client-config* (:client-config args))
-        client-config (merge @client-config config-bound)
-        encryption-client (:encryption-client-fn client-config)
-        amazon-client (:amazon-client-fn client-config)
-        transfer-manager (:transfer-manager-fn client-config)
-        crypto (if (even? (count (:args args)))
-                   (:encryption (apply hash-map (:args args))))
-        client  (if (and crypto (or (= (.getSimpleName clazz) "AmazonS3Client")
-                                    (= (.getSimpleName clazz) "TransferManager")))
-                    (delay (encryption-client crypto credential client-config))
-                    (delay (amazon-client clazz credential client-config)))]
-        (if (= (.getSimpleName clazz) "TransferManager")
-            (transfer-manager credential client-config crypto)
-            @client)))
-
-
-(defn- fn-call
-  "Returns a function that reflectively invokes method on
+ (swap! client-config assoc :transfer-manager-fn (memoize transfer-manager*))
+
+ (defn candidate-client
+   [clazz args]
+   (let [cred-bound (or *credentials* (:credential args))
+         credential (if (map? cred-bound)
+                      (merge @credential cred-bound)
+                      (or cred-bound @credential))
+         config-bound (or *client-config* (:client-config args))
+         client-config (merge @client-config config-bound)
+         encryption-client (:encryption-client-fn client-config)
+         amazon-client (:amazon-client-fn client-config)
+         transfer-manager (:transfer-manager-fn client-config)
+         crypto (if (even? (count (:args args)))
+                  (:encryption (apply hash-map (:args args))))
+         client  (if (and crypto (or (= (.getSimpleName clazz) "AmazonS3Client")
+                                     (= (.getSimpleName clazz) "TransferManager")))
+                   (delay (encryption-client crypto credential client-config))
+                   (delay (amazon-client clazz credential client-config)))]
+     (if (= (.getSimpleName clazz) "TransferManager")
+       (transfer-manager credential client-config crypto)
+       @client)))
+
+
+ (defn- fn-call
+   "Returns a function that reflectively invokes method on
    clazz with supplied args (if any). The 'method' here is
    the Java method on the Amazon*Client class."
-  [clazz method & arg]
-  (binding [*client-class* clazz]
-    (let [args    (args-from arg)
-          arg-arr (prepare-args method (:args args))
-          client  (delay (candidate-client clazz args))]
-      (fn []
-        (try
-          (let [java (.invoke method @client arg-arr)
-                cloj (marshall java)]
-            (if (and
+   [clazz method & arg]
+   (binding [*client-class* clazz]
+     (let [args    (args-from arg)
+           arg-arr (prepare-args method (:args args))
+           client  (delay (candidate-client clazz args))]
+       (fn []
+         (try
+           (let [java (.invoke method @client arg-arr)
+                 cloj (marshall java)]
+             (if (and
                   @root-unwrapping
                   (map? cloj)
                   (= 1 (count (keys cloj))))
-              (-> cloj first second)
-              cloj))
-          (catch InvocationTargetException ite
-            (throw (.getTargetException ite))))))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+               (-> cloj first second)
+               cloj))
+           (catch InvocationTargetException ite
+             (throw (.getTargetException ite))))))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ )


Some more code

Some more code

untested, everything.

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

--- src/conexp/layout/force.clj
+++ src/conexp/layout/force.clj
@@ -6,27 +6,57 @@

 ;; Repulsive Energy

-(defn node-line-distance
+(defn- node-line-distance
   "Returns the distance from node to the line between x and y."
   [node [x y]]
   )

-(defn repulsive-energy [[node-positions node-connections]]
-  0)
+(defn- repulsive-energy
+  "Computes the repulsive energy of the given layout."
+  [[node-positions node-connections]]
+  (reduce (fn [sum v]
+	    (+ sum
+	       (reduce (fn [sum [x y]]
+			 (if (or (= x v) (= y v))
+			   sum
+			   (+ sum
+			      (/ 1 (node-line-distance (node-positions v)
+						       [(node-positions x), (node-positions y)])))))
+			 0
+			 node-connections)))
+	  0
+	  (keys node-positions)))

 ;; Attractive Energy

-(defn attractive-energy [[node-positions node-connections]]
-  0)
+(defn- square
+  "Squares."
+  [x]
+  (* x x))
+
+(defn- line-length
+  "Returns the length of the line between [x_1, y_1] and [x_2, y_2]."
+  [[x_1, y_1] [x_2, y_2]]
+  (Math/sqrt (+ (square (- x_1 x_2))
+		(square (- y_1 y_2)))))
+
+(defn- attractive-energy
+  "Computes the attractive energy of the given layout."
+  [[node-positions node-connections]]
+  (reduce (fn [sum [x y]]
+	    (+ sum
+	       (square (line-length [(node-positions x), (node-positions y)]))))
+	  0
+	  node-connections))

 ;; Gravitative Energy

-(defn gravitative-energy [[node-positions node-connections]]
+(defn- gravitative-energy [[node-positions node-connections]]
   0)

 ;; Overall Energy

-(defn layout-energy
+(defn- layout-energy
   "Returns the overall energy of the given layout. The coefficients r,
   a and g give the amount of repulsive, attractive and gravitative
   energy, respectively."
@@ -35,7 +65,7 @@
      (* a (attractive-energy layout))
      (* g (gravitative-energy layout))))

-(defn energy-by-inf-irr-positions
+(defn- energy-by-inf-irr-positions
   "Returns a function calculating the energy of an attribute additive
   layout of lattice given by the positions of the infimum irreducible
   elements. seq-of-inf-irrs gives the order of the infimum irreducible


use diffing for =, fix docstrings

use diffing for =, fix docstrings

--- src/matcha.clj
+++ src/matcha.clj
@@ -7,7 +7,8 @@
      instance? string? map? seq? char? vector? nil? keyword? symbol? ratio? decimal? float? isa? rational? coll? set? list? fn?])
   (:require [clojure.string :as string]
             [clojure.core :as core]
-            [clojure.test :as test]))
+            [clojure.test :as test]
+            [clojure.data :as data]))
 ;; Matcher
 ;; Match
 ;;
@@ -74,7 +75,12 @@
   [a]
   {:match (fn [b] (core/= a b))
    :description (pr-str a)
-   :describe-mismatch describe-class-mismatch})
+   :describe-mismatch
+   (fn [x]
+     (let [[things-in-a things-in-x things-in-both] (data/diff a x)]
+       (str (describe-class-mismatch x)
+         "\n+" (pr-str things-in-a)
+         "\n-" (pr-str things-in-x))))})

 (defn <=
   "matches based if the value given is greater-than or equal to
@@ -587,7 +593,7 @@
     (matcha/run-match matcha/truthy? nil) ; => fails"}
   truthy?
   {:match identity
-   :description "a set"})
+   :description "a truthy value"})

 (def
   ^{:doc
@@ -597,7 +603,7 @@
     (matcha/run-match matcha/falsey? nil) ; => fails"}
   falsey?
   {:match not
-   :description "a set"})
+   :description "a falsey value"})

 (def
   ^{:doc


Throw exception on complete failure.

Throw exception on complete failure.

--- src/onyx/coordinator/impl.clj
+++ src/onyx/coordinator/impl.clj
@@ -151,7 +151,7 @@

         {:n-peers n :peer-state peer-state})
       (do (extensions/write-node sync cooldown-down {:completed? true})
-          {:n-peers n :peer-state peer-state}))))
+          (throw (ex-info "Failed to complete task" {:complete? complete? :n n}))))))

 (defn incomplete-job-ids [sync]
   (let [job-nodes (extensions/bucket sync :job)


workign on zipper logic

workign on zipper logic

--- src/bracketolojy/tournament.clj
+++ src/bracketolojy/tournament.clj
@@ -57,7 +57,7 @@
       :root)))

 (defmulti #^{:private true} compute-round
-  compute-round-dispatch)
+          compute-round-dispatch)
 (defmethod compute-round :default [_ node]
   node)
 (defmethod compute-round :branch [_ node]
@@ -100,10 +100,10 @@
     :branch))

 (defmulti #^{:private true} compute-matchup
-  "Compute a matchup.  The first argument is an associative structure that gives the points per a correct pick
-   for each round.  The second argument is an associative structure that gives the points per an upset pick for each
-   round.  The third and final argument is the matchup data to perform the computation on."
-   compute-matchup-dispatch)
+          "Compute a matchup.  The first argument is an associative structure that gives the points per a correct pick
+           for each round.  The second argument is an associative structure that gives the points per an upset pick for each
+           round.  The third and final argument is the matchup data to perform the computation on."
+          compute-matchup-dispatch)
 (defmethod compute-matchup :default [_ _ node]
   node)
 (defmethod compute-matchup :branch [pick-pts-fn upset-pts-fn node]
@@ -137,28 +137,28 @@
 (defn- update-child-expected-value
   "Update the expected value of each team in the field using parent-team-map.  The expected value for each team in the
   field is the team's average points plus the expected value of the team in the parent-team-map."
-  [parent-team-map [field children]]
-  (vector
-    (map
-      #(update-in % [:expected-value] (fnil + 0 0)
-                  (get-in parent-team-map [(:name %) :expected-value])
-                  (:avg-pts %))
-      field)
-    children))
+  [parent-team-map node]
+  (update-in node [:data :teams]
+             (partial
+               map
+               #(update-in % [:expected-value] (fnil + 0 0)
+                           (get-in parent-team-map [(:name %) :expected-value])
+                           (:avg-pts %)))))

 (defn- update-expected-value
   "For each child in children, update the expected value of the teams in that child's field.  The expected value for each team
   in a field is the team's average points plus the expected value of the team in the parent field."
-  [[field children]]
-  (vector
-    field
-    (let [parent-team-map (->>
-                            field
-                            (map #((juxt :name identity) %))
-                            (into {}))]
-      (map
-        (partial update-child-expected-value parent-team-map)
-        children))))
+  [node]
+  (let [field (get-in node [:data :teams])
+        children ((juxt :upper :lower) node)]
+    (vector
+      field
+      (let [parent-team-map (->> field
+                                 (map #((juxt :name identity) %))
+                                 (into {}))]
+        (map
+          (partial update-child-expected-value parent-team-map)
+          children)))))

 (defn- compute-expected-value-helper
   "Recursively traverse the zipper, updating each node with the expected value computation."
@@ -167,20 +167,26 @@
     loc
     (recur (zip/next (zip/edit loc update-expected-value)))))

+(defn- branch? [node]
+  (and (map? node) (contains? node :upper) (contains? node :lower)))
+
+(defn children [node]
+  ((juxt :upper :lower) node))
+
+(defn make-node [existing [upper lower]]
+  (-> (assoc-in existing [:upper] upper)
+      (assoc-in [:lower] lower)))
+
 (defn compute-expected-value
   "Compute the expected value for each node in the tournament probabilites tree."
   [tp]
-  (->>
-    (update-child-expected-value nil tp)
-    (zip/zipper
-      (fn [[_ cn]]
-        (or (vector? cn) (seq? cn)))
-      (fn [[_ cn]]
-        (seq cn))
-      (fn [node cn]
-        (assoc node 1 cn)))
-    compute-expected-value-helper
-    zip/root))
+  (->> (update-child-expected-value nil tp)
+       (zip/zipper
+         branch?
+         children
+         make-node)
+       compute-expected-value-helper
+       zip/root))

 (defn predict-bracket
   "Predict the expected value for each team in each round of the tournament.  Bracket should be
@@ -195,4 +201,5 @@
        (round-info 7)
        (tournament-probabilities
          pick-scoring
-         upset-scoring)))+         upset-scoring)
+       compute-expected-value))


Added proper type-hinting to read-locked and write-locked functions in util.

For comparison:

user> (def k (mk-rw-lock))
user> (time (dotimes [_ 100000] (read-locked k 10)))
Reflection warning, NO_SOURCE_FILE:1 - reference to field readLock can't be resolved.
Reflection warning, NO_SOURCE_FILE:1 - reference to field lock can't be resolved.
Reflection warning, NO_SOURCE_FILE:1 - reference to field unlock can't be resolved.
"Elapsed time: 1400.476 msecs"
nil
user> (time (dotimes [_ 100000] (read-locked k 10)))
"Elapsed time: 20.137 msecs"
nil

--- src/clj/backtype/storm/util.clj
+++ src/clj/backtype/storm/util.clj
@@ -314,18 +314,18 @@
   (ReentrantReadWriteLock.))

 (defmacro read-locked [rw-lock & body]
-  `(let [rlock# (.readLock ~rw-lock)]
-      (try
-        (.lock rlock#)
-        ~@body
-      (finally (.unlock rlock#)))))
+  (let [lock (with-meta rw-lock {:tag `ReentrantReadWriteLock})]
+    `(let [rlock# (.readLock ~lock)]
+       (try (.lock rlock#)
+            ~@body
+            (finally (.unlock rlock#))))))

 (defmacro write-locked [rw-lock & body]
-  `(let [wlock# (.writeLock ~rw-lock)]
-      (try
-        (.lock wlock#)
-        ~@body
-      (finally (.unlock wlock#)))))
+  (let [lock (with-meta rw-lock {:tag `ReentrantReadWriteLock})]
+    `(let [wlock# (.writeLock ~lock)]
+       (try (.lock wlock#)
+            ~@body
+            (finally (.unlock wlock#))))))

 (defn wait-for-condition [apredicate]
   (while (not (apredicate))


prevent Medium/Nerve Agent from being repeatedly clicked during access

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -342,7 +342,8 @@
     :abilities [{:req (req (and run
                                 (= (first (get-in @state [:run :server])) :rd)
                                 (not current-ice)
-                                (:medium-active card)))
+                                (:medium-active card)
+                                (empty? (get-in @state [:runner :prompt]))))
                  :effect (effect (add-prop card :counter 1)
                                  (resolve-ability
                                    {:prompt "Choose how many additional R&D accesses to make"
@@ -370,7 +371,8 @@
     :abilities [{:req (req (and run
                                 (= (first (get-in @state [:run :server])) :hq)
                                 (not current-ice)
-                                (:nerve-active card)))
+                                (:nerve-active card)
+                                (empty? (get-in @state [:runner :prompt]))))
                  :effect (effect (add-prop card :counter 1)
                                  (resolve-ability
                                    {:prompt "Choose how many additional HQ accesses to make"


Implemented Amazon Industrial Zone

Implemented Amazon Industrial Zone

--- src/clj/game/cards-upgrades.clj
+++ src/clj/game/cards-upgrades.clj
@@ -7,6 +7,15 @@
                                       (= (card->server state card) (card->server state target))))
                        :effect (effect (rez-cost-bonus -2))}}}

+   "Amazon Industrial Zone"
+   {:events
+     {:corp-install  {:optional {:req (req (and (= (:type target) "ICE")
+                                                (= (card->server state card) (card->server state target))))
+                                 :prompt "Rez ICE with rez cost lowered by 3?"
+                                 :effect (effect
+                                           (rez-cost-bonus -3)
+                                           (rez target))}}}}
+
    "Ash 2X3ZB9CY"
    {:abilities [{:label "Trace 4 - Prevent the Runner from accessing cards other than Ash 2X3ZB9CY"
                  :trace {:base 4


Move REPL input to a card

Move REPL input to a card

--- src/cljs/cljs_webrepl/core.cljs
+++ src/cljs/cljs_webrepl/core.cljs
@@ -283,13 +283,34 @@
         :on-click #(eval-input state)}
        [:i.material-icons "send"]]]]))

-(defn input [props]
+(defn repl-input [props]
   [:div.input
    [:div.mdl-grid.mdl-shadow--2dp.white-bg
     [:div.mdl-cell--12-col
      [:div.flex-h
       [input-field props]
       [run-button props]]]]])
+
+(defn input-card [{:keys [state] :as props} num]
+  [:div.mdl-cell.mdl-cell--12-col
+   [:div.mdl-card.mdl-shadow--2dp
+    [repl-input props]]])
+
+(defn input-ok? [{:keys [history]}]
+  (or (= (count history) 0)
+      (some? (-> history last second :result))))
+
+(defn history [props]
+  ^{:key (count (:history @state))}
+  [scroll-on-update
+   [:div.history
+    [:div.mdl-grid
+     (doall
+      (for [[num history-item] (:history @state)]
+        ^{:key num}
+        [history-card props num history-item]))
+     (when (input-ok? @state)
+       [input-card props])]]])

 (defn close-about-dialog []
   (when-let [dialog (.querySelector js/document "#about-dialog")]
@@ -352,8 +373,7 @@
             "About"]]]]
         (if (:ns @state)
           [history props]
-          [please-wait props])
-        [input props]]]]]))
+          [please-wait props])]]]]))

 (defn mount-root []
   (r/render [home-page] (.getElementById js/document "app")))


Make the comic-list component dependent on the site

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -54,16 +54,20 @@
                   site-list)]))))

 (defn comic-list []
-  (let [comic-list (rf/subscribe [:comic-list])]
+  (let [site (rf/subscribe [:site])
+        comic-list (rf/subscribe [:comic-list])]
     (fn []
-      (when-let [comic-list @comic-list]
-        [:ul (map (comp
-                   (id-btn-for-callback
-                    #(go-to (read-path {:comic (:name %)
-                                        :chapter 1
-                                        :page 1})))
-                   #(assoc % :id (:name %)))
-                  comic-list)]))))
+      (let [site       @site
+            comic-list @comic-list]
+        (when (and site comic-list)
+          [:ul (map (comp
+                     (id-btn-for-callback
+                      #(go-to (read-path {:site site
+                                          :comic (:name %)
+                                          :chapter 1
+                                          :page 1})))
+                     #(assoc % :id (:name %)))
+                    comic-list)])))))

 (defn reader []
   (let [location   (rf/subscribe [:location])


Fix wrong ns name.

Fix wrong ns name.

--- src/clojure/buddy/core/util.clj
+++ src/clojure/buddy/core/util.clj
@@ -12,7 +12,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.

-(ns buddy.util
+(ns buddy.core.util
   (:require [clojure.algo.monads :refer [domonad maybe-m]]))

 (defmacro maybe-let


Clojure 1.9 alpha compatibility.

Clojure 1.9 alpha compatibility.

--- src/clojure/clj_chess/game.cljc
+++ src/clojure/clj_chess/game.cljc
@@ -724,51 +724,51 @@
     (node-to-string (:root-node game))))

 (defn- ecn-move-text [game & {:keys [include-comments? include-variations?
-                                     binary?]
-                              :or {:include-comments? true
-                                   :include-variations? true}}]
-  (if binary?
-    [:byte-moves #?(:clj (byte-array (map (fn [[b m]] (board/move-to-byte b m))
-                                          (boards-with-moves game)))
-                    :cljs (throw
-                            (js/Error
-                              "Binary move encoding is not supported in cljs")))]
-    (letfn [(node-to-ecn [node]
-              (let [board (:board node)
-                    children (:children node)]
-                (when-not (empty? children)
-                  (filterv
-                    identity
-                    `[; Pre-comment for first child move
-                      ~(when include-comments?
-                         (when-let [c (:pre-comment (first children))]
-                           [:pre-comment c]))
-                      ; String representation of first child move (main variation):
-                      ~(-> (first children) :board board/last-move
-                           board/move-to-uci)
-                      ; Comment for first child move:
-                      ~(when include-comments?
-                         (when-let [c (:comment (first children))]
-                           [:comment c]))
-                      ; Recursive annotation variations for younger children:
-                      ~@(when include-variations?
-                          (mapv (fn [child]
-                                  (let [m (-> child :board board/last-move)]
-                                    (filterv
-                                      identity
-                                      `[:variation
-                                        ~(when include-comments?
-                                           (when-let [c (:pre-comment child)]
-                                             [:pre-comment c]))
-                                        ~(board/move-to-uci m)
-                                        ~(when include-comments?
-                                           (when-let [c (:comment child)]
-                                             [:comment c]))
-                                        ~@(node-to-ecn child)])))
-                                (rest children)))
-                      ; Game continuation after first child move:
-                      ~@(node-to-ecn (first children))]))))]
-      `[:moves ~@(node-to-ecn (:root-node game))])))
+                                     binary?]}]
+  (let [include-comments? (or include-comments? true)
+        include-variations? (or include-variations? true)]
+    (if binary?
+      [:byte-moves #?(:clj  (byte-array (map (fn [[b m]] (board/move-to-byte b m))
+                                             (boards-with-moves game)))
+                      :cljs (throw
+                              (js/Error
+                                "Binary move encoding is not supported in cljs")))]
+      (letfn [(node-to-ecn [node]
+                (let [board (:board node)
+                      children (:children node)]
+                  (when-not (empty? children)
+                    (filterv
+                      identity
+                      `[; Pre-comment for first child move
+                        ~(when include-comments?
+                           (when-let [c (:pre-comment (first children))]
+                             [:pre-comment c]))
+                        ; String representation of first child move (main variation):
+                        ~(-> (first children) :board board/last-move
+                             board/move-to-uci)
+                        ; Comment for first child move:
+                        ~(when include-comments?
+                           (when-let [c (:comment (first children))]
+                             [:comment c]))
+                        ; Recursive annotation variations for younger children:
+                        ~@(when include-variations?
+                            (mapv (fn [child]
+                                    (let [m (-> child :board board/last-move)]
+                                      (filterv
+                                        identity
+                                        `[:variation
+                                          ~(when include-comments?
+                                             (when-let [c (:pre-comment child)]
+                                               [:pre-comment c]))
+                                          ~(board/move-to-uci m)
+                                          ~(when include-comments?
+                                             (when-let [c (:comment child)]
+                                               [:comment c]))
+                                          ~@(node-to-ecn child)])))
+                                  (rest children)))
+                        ; Game continuation after first child move:
+                        ~@(node-to-ecn (first children))]))))]
+        `[:moves ~@(node-to-ecn (:root-node game))]))))

 (defn- wrap [text column]


Add a set of logging wrapper functions

Add a set of logging wrapper functions

Because I'm tired of manually adding the message loop name and current
thread to log formatting messages.

--- src/clojure/frereth_cp/util.clj
+++ src/clojure/frereth_cp/util.clj
@@ -6,10 +6,42 @@
   ;; pprint
   (:require [clojure.pprint :as pprint]
             [clojure.spec.alpha :as s]
+            [clojure.string :as string]
             [clojure.tools.logging :as log])
   (:import clojure.lang.ExceptionInfo))

 (set! *warn-on-reflection* true)
+
+;;;; Logging wrappers
+
+;;; TODO: Debug this
+;;; (in a different branch...don't get derailed from the current one)
+(defmacro def-log-fn
+  "I'm starting to add enough boilerplate to be annoying"
+  [lvl-name]
+  (let [lvl lvl-name
+        loop-name (gensym)
+        args-name (gensym)]
+    `(defn ~lvl
+       [~loop-name & ~args-name]
+       (~(symbol (str "log/" lvl)) (pprint/cl-format nil
+                                                     "~a (~a):"
+                                                     ~loop-name
+                                                     (Thread/currentThread))
+        (string/join " " ~args-name)))))
+(doseq [wrapper-name '[trace debug info warn error]]
+  (eval `(def-log-fn ~wrapper-name)))
+
+(comment
+  (macroexpand-1 '(def-log-fn debug))
+  (def-log-fn debug)
+  (debug "here" "check")
+  (let [wrapper-name 'debug]
+    (macroexpand-1 `(def-log-fn ~wrapper-name)))
+  (debug "check" "abc" "def")
+)
+
+;;;; More traditional pieces

 ;; TODO: Rename this to seconds-in-millis
 (defn seconds [] 1000)  ; avoid collision w/ built-in second
@@ -21,6 +53,9 @@
   [ss]
   (* ss 1000000000))

+;;; TODO: Try to :require fipp
+;;; If it's available, define pretty using it instead of
+;;; pprint
 (defn pretty
   "Return a pretty-printed representation of xs"
   [& xs]
@@ -54,8 +89,9 @@
         :ret string?)
 (defn show-stack-trace
   "Convert stack trace to a readable string
-Slow and inefficient, but you have bigger issues than
-performance if you're calling this"
+  Slow and inefficient, but you have bigger issues than
+  performance if you're calling this"
+  ;; This is more-or-less a built-in. TODO: Switch to using that
   [^Throwable ex]
   (let [base (if (instance? ExceptionInfo ex)
                (str ex "\n" (pretty (.getData ^ExceptionInfo ex)))


CMR-702: Ordering of CMR results does not match catalog-rest

--- src/cmr/search/models/query.clj
+++ src/cmr/search/models/query.clj
@@ -281,7 +281,8 @@
 (def default-sort-keys
   {:granule [{:field :provider-id :order :asc}
              {:field :start-date :order :asc}]
-   :collection [{:field :entry-title :order :asc}]})
+   :collection [{:field :entry-title :order :asc}
+                {:field :provider-id :order :asc}]})

 (def concept-type->default-query-attribs
   {:granule {:condition (->MatchAllCondition)


Missing data from images having consecutive IFDs

Infinite loop avoidance code caused only the first IFD to be read.

--- src/remworks/exif_reader.cljc
+++ src/remworks/exif_reader.cljc
@@ -339,12 +339,14 @@
         num         (data-view/getUint16 data offset le)
         next-offset (data-view/getUint32 data (+ offset 2 (* num 12)) le)
         res         (for [offset (map #(+ offset 2 (* 12 %)) (range num))]
-                      (let [ifd          (ifd data offset le group)
-                            tag          (:tag ifd)
-                            next-offset  (:value ifd)
-                            seen-offsets (conj seen-offsets (:value ifd))]
-                        (if (and tag (tag-names tag))
-                          (ifds data (:value ifd) le :group tag, :seen-offsets seen-offsets)
+                      (let [ifd         (ifd data offset le group)
+                            tag         (:tag ifd)
+                            next-offset (:value ifd)]
+                        (if (and tag (tag-names tag)
+                                 (not (seen-offsets next-offset)))
+                          (ifds data (:value ifd) le
+                                :group tag
+                                :seen-offsets (conj seen-offsets (:value ifd)))
                           ifd)))
         res         (->> res
                          flatten
@@ -352,7 +354,7 @@
     (if (and next-offset
              (> next-offset 0)
              (< next-offset (data-view/getLength data))
-             (seen-offsets next-offset))
+             (not (seen-offsets next-offset)))
       (concat res (ifds data next-offset le
                         :group group
                         :seen-offsets (conj seen-offsets next-offset)))


JVM opt for disabling epoll

JVM opt for disabling epoll

There are still cases where Linux amd64 host can't use the netty epoll
driver - e.g. on CentOS 5, where the glibc version is too old to run it.

This change allows disabling the default and fallback to the pure-java
implementation by adding `-Dnetty.epoll.enabled=false` to JVM opts.

--- src/riemann/transport/tcp.clj
+++ src/riemann/transport/tcp.clj
@@ -77,7 +77,8 @@
   Linux only. Provide pure-Java implementation of Netty on all other
   platforms. See http://netty.io/wiki/native-transports.html"
   (if (and (.contains (. System getProperty "os.name") "Linux")
-           (.contains (. System getProperty "os.arch") "amd64"))
+           (.contains (. System getProperty "os.arch") "amd64")
+           (.equals (System/getProperty "netty.epoll.enabled" "true") "true"))
     {:event-loop-group-fn #(EpollEventLoopGroup.)
      :channel EpollServerSocketChannel}
     {:event-loop-group-fn #(NioEventLoopGroup.)


Restructure a bit to be more readable

Restructure a bit to be more readable

--- src/ecregister/posts_ui.clj
+++ src/ecregister/posts_ui.clj
@@ -21,7 +21,51 @@
    :border (line-border :color "#ccc" :thickness 1)
    :minimum-size [400 :by 60]))

-(defn setup-events [form event-chan create-tap]
+
+(defn update-fa-post-widget [e form]
+  ;; TODO use cond
+  (if (= :wait (:value e))
+    (config! (select form [:#faprog]) :indeterminate? true)
+    (let [author (:author (:value e))
+          title (:title (:value e))]
+      (config! (select form [:#latest-fa-post :> :#author]) :text author)
+      (config! (select form [:#latest-fa-post :> :#title]) :text title)
+      (config! (select form [:#faprog]) :visible? false)
+      (config! (select form [:#latest-fa-post]) :visible? true)
+      )))
+
+(defn fetch-aw-posts [e form]
+  (let [c (async/chan)
+        content-chan (async/chan)
+        fa-post (:value e)]
+    ;; FIXME if c will contain :error, dismiss all fetched so far and clear listbox
+    (posts/fetch-unpublished-aw-posts fa-post c)
+    ;; as posts arrive they get accumulated until it is known that there's no error.
+    ;; when :end is received, fetching of actual post content starts
+    (async/go-loop [fetched []]
+      (let [post (async/<! c)]
+        (cond
+         (= :error post) (prn "ERROR!") ;; FIXME clear list from all fetched so far, do other cleanup stuff, disable buttons etc
+         (not= :end post) (do
+                            (add! (select form [:#aw-posts]) (make-post-widget post))
+                            (recur (conj fetched post)))
+         (= :end post) (posts/fetch-aw-posts-content fetched content-chan))))
+    ;; after above function started retrieving full content, let's wait for it to arrive and accumulate posts as they go
+    (async/go-loop [full-posts []]
+      (let [post (async/<! content-chan)]
+        (cond
+         (= :error post) (prn "ERROR getting full post!")
+         (not= :end post) (do
+                            (prn "got full post fetched" (:title post) "by" (:author post))
+                            (config! (select form [(str "#" (:id post))]) :border (line-border :color "#8e80e4" :thickness 1))
+                            (recur (conj full-posts post)))
+         (= :end post) (do
+                         (prn "all posts fetched")
+                         (config! (select form [:#publish-btn]) :enabled? (not (empty? full-posts)))
+                         (config! (select form [:#publish-btn]) :user-data full-posts)
+                         ))))))
+
+(defn setup-events [form event-chan map-stream]
   (listen (select form [:#publish-btn])
           :mouse-clicked (fn [e]
                            (when-let [posts (config (select form [:#publish-btn]) :user-data)]
@@ -38,62 +82,10 @@
                                                (dialog :content
                                                        (str "Successfully sent " (:value res) " posts"))))))))))))

-  (let [fa-stream (create-tap #(= :fa-post (:id %)))
-        fa-post-stream (create-tap #(and (= :fa-post (:id %)) (map? (:value %))))
-        posts-ready-stream (create-tap #(= :posts-ready (:id %)))
-        ]
-    ;; setup 'latest post' label and progressbar
-    (async/go-loop []
-      (let [e (async/<! fa-stream)]
-        (prn "fa-stream =>" e)
-        ;; TODO use cond
-        (if (= :wait (:value e))
-          (config! (select form [:#faprog]) :indeterminate? true)
-          (let [author (:author (:value e))
-                title (:title (:value e))]
-            (config! (select form [:#latest-fa-post :> :#author]) :text author)
-            (config! (select form [:#latest-fa-post :> :#title]) :text title)
-            (config! (select form [:#faprog]) :visible? false)
-            (config! (select form [:#latest-fa-post]) :visible? true)
-            )))
-      (recur))
-    ;; when fa post is retrived, start fetching aw posts
-    (async/go-loop []
-      (let [e (async/<! fa-post-stream)
-            c (async/chan)
-            content-chan (async/chan)
-            fa-post (:value e)]
-        (prn "fa-post-stream =>" e)
-        ;; FIXME if c will contain :error, dismiss all fetched so far and clear listbox
-        (posts/fetch-unpublished-aw-posts fa-post c)
-        ;; as posts arrive they get accumulated until it is known that there's no error.
-        ;; when :end is received, fetching of actual post content starts
-        (async/go-loop
-            [fetched []]
-          (let [post (async/<! c)]
-            (cond
-             (= :error post) (prn "ERROR!") ;; FIXME clear list from all fetched so far, do other cleanup stuff, disable buttons etc
-             (not= :end post) (do
-                                (add! (select form [:#aw-posts]) (make-post-widget post))
-                                (recur (conj fetched post)))
-             (= :end post) (posts/fetch-aw-posts-content fetched content-chan))))
-        ;; after above function started retrieving full content, let's wait for it to arrive and accumulate posts as they go
-        (async/go-loop
-            [full-posts []]
-          (let [post (async/<! content-chan)]
-            (cond
-             (= :error post) (prn "ERROR getting full post!")
-             (not= :end post) (do
-                                (prn "got full post fetched" (:title post) "by" (:author post))
-                                (config! (select form [(str "#" (:id post))]) :border (line-border :color "#8e80e4" :thickness 1))
-                                (recur (conj full-posts post)))
-             (= :end post) (do
-                             (prn "all posts fetched")
-                             (config! (select form [:#publish-btn]) :enabled? (not (empty? full-posts)))
-                             (config! (select form [:#publish-btn]) :user-data full-posts)
-                             )))))
-      (recur))
-    ))
+  ;; setup 'latest post' label and progressbar
+  (map-stream #(= :fa-post (:id %)) #(update-fa-post-widget % form))
+  ;; when fa post is retrived, start fetching aw posts
+  (map-stream #(and (= :fa-post (:id %)) (map? (:value %))) #(fetch-aw-posts % form)))

 (defn launch-tab [event-chan]
   (let [c (async/chan)]
@@ -121,8 +113,15 @@
          :constraints ["fill,gap 18px,hidemode 3"])
         ev-chan (async/chan)
         ev-mult (async/mult ev-chan)
-        tap-creator (fn [predfn] (async/filter< predfn (async/tap ev-mult (async/chan))))
+        tap-creator (fn [pred] (async/filter< pred (async/tap ev-mult (async/chan))))
+        map-stream (fn [pred f]
+                     (let [tap (tap-creator pred)]
+                       (async/go-loop []
+                         (let [ev (async/<! tap)]
+                           (f ev)
+                           (recur)))))
+
         ]
-    (setup-events form ev-chan tap-creator)
+    (setup-events form ev-chan map-stream)
     (launch-tab ev-chan)
     form))


Serve absolute resources. Fixes #20.

Serve absolute resources. Fixes #20.

Also returns a stub map if the file is missing, to avoid a missing
file (included in another profile, perhaps), causing a fatal error.

--- src/aero/core.clj
+++ src/aero/core.clj
@@ -76,7 +76,13 @@
     (get-in-conf config)))

 (defn relative-resolver [source include]
-  (io/file (-> source io/file .getParent) include))
+  (let [fl
+        (if (.isAbsolute (io/file include))
+          (io/file include)
+          (io/file (-> source io/file .getParent) include))]
+    (if (.exists fl)
+      fl
+      (java.io.StringReader. (pr-str {:missing-include include})))))

 (defn resource-resolver [_ include]
   (io/resource include))


Fix confirmation

Fix confirmation

--- src/app/core.cljs
+++ src/app/core.cljs
@@ -338,7 +338,7 @@
        [:ul
         (map (fn [{:keys [id name] :as guest}]
                [:li (str name
-                         (if (get-in response [:infos id]) " will " " will not ")
+                         (if (get-in response [:infos id :attending]) " will " " will not ")
                          "attend.")])
              guests)])
      [:h2 "Doesn't look right?"]


remove debugging lines

remove debugging lines

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -130,7 +130,6 @@
             (fn [~destruct]
               (when (and ~pred
                          (run-file-task? (file ~name) '~deps))
-                (println "inside defile")
                 (mkdir (.getParentFile *File*))
                 ~@actions)))))


Fix signature of write-str

Fix signature of write-str

--- src/cavm/json.clj
+++ src/cavm/json.clj
@@ -26,8 +26,8 @@
 (extend java.lang.Float json/JSONWriter {:-write write-floating-point})
 (extend java.lang.Double json/JSONWriter {:-write write-floating-point})

-(defn write-str [s]
-  (json/write-str s))
+(defn write-str [s & args]
+  (apply json/write-str s args))

 (defn read-str [s]
   (json/read-str s))


Remove ddl file for now.

Remove ddl file for now.

--- src/cbfg/ddl.cljs
+++ src/cbfg/ddl.cljs
@@ -1,64 +0,0 @@
-(ns cbfg.ddl)
-
-(def cluster {})
-
-(def hi "world")
-
-;; ------------------------------------------------
-
-(def bucket-kinds
-  {:memcached {:cap 'cp
-               :allowed-ops [:get :set :del :arith :append]}
-   :couchbase {:cap 'cp
-               :allowed-ops [:get :set :del :arith :append]}
-   :couchdb   {:cap 'ap
-               :allowed-ops [:get :cas-set :cas-del]}})
-
-;; cfg stuff is admininistrator chosen values.
-;; cfg stuff has uuid'ed / version / parent.
-
-(def cfg-model {:name "name your model cfg"
-                :clusters {}})
-(def cfg-cluster {:parent-model nil
-                  :name "west"})
-(def cfg-bucket {:parent-cluster nil
-                 :name "default"
-                 :kind 'couchbase
-                 :num-partitions 0
-                 :per-node-mem-quota 0
-                 :indexes {}
-                 :storage-name "default"
-                 :replica-count 0
-                 :replica-rules []}) ; TODO: user/group/auth?
-(def cfg-index {:parent-bucket nil
-                :name "byCity"
-                :path "address.city"
-                :aggregate nil
-                :storage-name "default"}) ; TODO: view?
-(def cfg-node {:parent-cluster nil
-               :name "aaa"
-               :port 0
-               :container "" ; for zone/row/rack/shelf awareness.
-               :usage []
-               :weight 0.0})
-(def map-partitions {})
-
-(def node {:cfg-node {}
-           :memory {}
-           :processors 4
-           :storages {}
-           :buckets {}
-           :stats {}})
-(def node-storage {})
-
-(def node-bucket {:cfg-bucket {}
-                  :node-collections {}})
-(def node-collection {:node-partitions {}})
-(def node-partition {})
-
-(def write-queue {})
-(def read-queue {})
-
-(def send-queue {})
-(def recv-queue {})
-


More vis-init relayout for clarity.

More vis-init relayout for clarity.

--- src/cbfg/vis.cljs
+++ src/cbfg/vis.cljs
@@ -288,8 +288,13 @@
                              ;         :msgs {msg -> true}
                              ;         :first-taker-actx actx-or-nil}}.
                    :gen-id gen-id})
-        render-ch (chan)]
-    (go-loop [num-events 0]  ; Process events from world / simulation.
+        render-ch (chan)
+        el-event (str el-prefix "-event")
+        el-html (str el-prefix "-html")
+        el-svg (str el-prefix "-svg")
+        world (conj w 'world-1)] ; No ago for world actx init to avoid recursion.
+    (world-init-cb world)
+    (go-loop [num-events 0]      ; Process events from world / simulation.
       (let [[actx [verb step & args]] (<! event-ch)
             deltas ((get (get vis-event-handlers verb) step) vis actx args)
             event-str (str num-events ": " (last actx) " " verb " " step " " args)]
@@ -301,49 +306,44 @@
         (when (> @event-delay 0) (<! (timeout @event-delay)))
         (when (< @event-delay 0) (<! step-ch)))
         (recur (inc num-events)))
-    (let [el-event (str el-prefix "-event")
-          el-html (str el-prefix "-html")
-          el-svg (str el-prefix "-svg")
-          world (conj w 'world-1)]    ; No ago for world actx init to avoid recursion.
-      (world-init-cb world)
-      (go-loop [vis-last nil          ; Process render-ch, updating U/I.
-                vis-last-positions nil
-                vis-last-html nil
-                vis-last-svg nil
-                prev-deltas nil]
-        (let [[vis-next deltas after event-str] (<! render-ch)
-              next-deltas (take 20 (conj prev-deltas [after deltas]))]
-          (set-el-innerHTML el-event event-str)
-          (if after
-            (let [vis-next-positions (atom {})
-                  actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs vis-next))]
-              (assign-positions vis-next world vis-next-positions actx-ch-ch-infos
-                                (when (get-in vis-next [:actxs world :closed]) 0))
-              (let [vis-next-html (apply str (flatten (vis-html-actx vis-next world
-                                                                     actx-ch-ch-infos)))
-                    vis-next-svg (apply str (flatten (vis-svg-actxs vis-next @vis-next-positions
-                                                                    deltas true prev-deltas)))]
-                (when (not= vis-next-html vis-last-html)
-                  (set-el-innerHTML el-html vis-next-html)
-                  (when on-render-cb
-                    (on-render-cb vis-next)))
-                (when (not= vis-next-svg vis-last-svg)
-                  (set-el-innerHTML el-svg vis-next-svg))
-                (recur vis-next @vis-next-positions vis-next-html vis-next-svg next-deltas)))
-            (let [vis-next-svg (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
-                                                                  deltas false prev-deltas)))]
+    (go-loop [vis-last nil       ; Process render-ch, updating U/I.
+              vis-last-positions nil
+              vis-last-html nil
+              vis-last-svg nil
+              prev-deltas nil]
+      (let [[vis-next deltas after event-str] (<! render-ch)
+            next-deltas (take 20 (conj prev-deltas [after deltas]))]
+        (set-el-innerHTML el-event event-str)
+        (if after
+          (let [vis-next-positions (atom {})
+                actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs vis-next))]
+            (assign-positions vis-next world vis-next-positions actx-ch-ch-infos
+                              (when (get-in vis-next [:actxs world :closed]) 0))
+            (let [vis-next-html (apply str (flatten (vis-html-actx vis-next world
+                                                                   actx-ch-ch-infos)))
+                  vis-next-svg (apply str (flatten (vis-svg-actxs vis-next @vis-next-positions
+                                                                  deltas true prev-deltas)))]
+              (when (not= vis-next-html vis-last-html)
+                (set-el-innerHTML el-html vis-next-html)
+                (when on-render-cb
+                  (on-render-cb vis-next)))
               (when (not= vis-next-svg vis-last-svg)
                 (set-el-innerHTML el-svg vis-next-svg))
-              (recur vis-last vis-last-positions vis-last-html vis-next-svg next-deltas)))))
-      (let [toggle-ch (listen-el (gdom/getElement el-html) "click")] ; Process toggle U/I events.
-        (go-loop []
-          (let [actx-id (no-prefix (.-id (.-target (<! toggle-ch))))]
-            (doseq [[actx actx-info] (:actxs @vis)]
-              (when (= actx-id (last actx))
-                (swap! vis #(assoc-in % [:actxs actx :closed] (not (:closed actx-info))))
-                (>! render-ch [@vis nil true nil])))
-            (recur)))))
-    (vis-run-controls event-delay step-ch el-prefix)))
+              (recur vis-next @vis-next-positions vis-next-html vis-next-svg next-deltas)))
+          (let [vis-next-svg (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
+                                                                deltas false prev-deltas)))]
+            (when (not= vis-next-svg vis-last-svg)
+              (set-el-innerHTML el-svg vis-next-svg))
+            (recur vis-last vis-last-positions vis-last-html vis-next-svg next-deltas)))))
+    (vis-run-controls event-delay step-ch el-prefix)
+    (let [toggle-ch (listen-el (gdom/getElement el-html) "click")] ; Process toggle U/I events.
+      (go-loop []
+        (let [actx-id (no-prefix (.-id (.-target (<! toggle-ch))))]
+          (doseq [[actx actx-info] (:actxs @vis)]
+            (when (= actx-id (last actx))
+              (swap! vis #(assoc-in % [:actxs actx :closed] (not (:closed actx-info))))
+              (>! render-ch [@vis nil true nil])))
+          (recur))))))

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


Timeout 20

Timeout 20

--- src/cljs/map.cljs
+++ src/cljs/map.cljs
@@ -68,7 +68,7 @@
                (.addLayer markers marker))))))
     (remote-callback :get-markers [dbb]
                      #(go (doseq [a (if (= maxi 0) % (take maxi %))]
-                            (<! (timeout 50))
+                            (<! (timeout 20))
                             (>! ch a))))
     (.addLayer mymap markers)
     (remote-callback


include visibility and forkness as data attributes

--- src/otto/html.clj
+++ src/otto/html.clj
@@ -23,17 +23,24 @@
     "–"
     (.format (java.text.SimpleDateFormat. "dd-MM-yyyy") date)))

+(defn- repository-data-attributes
+  [fork private]
+  {:data-fork    (format "%s" fork)
+   :data-private (format "%s" private)})
+
 (defn- repository-detail
   [repository]
-  [:tr (if (= true (:private repository))
-         {:class "active"})
-   [:td (link-to (:html_url repository) (:name repository))]
-   [:td (format-string (:description repository))
-        " "
-        (if (= true (:fork repository))
-          [:span {:class "label label-default"} "fork"])]
-   [:td (format-string (:language repository))]
-   [:td.date (format-date (:pushed_at repository))]])
+  (let [fork    (:fork repository)
+        private (:private repository)]
+    [:tr (merge (if private {:class "active"}
+                            {}) (repository-data-attributes fork private))
+     [:td (link-to (:html_url repository) (:name repository))]
+     [:td (format-string (:description repository))
+          " "
+          (if (= true fork)
+            [:span {:class "label label-default"} "fork"])]
+     [:td (format-string (:language repository))]
+     [:td.date (format-date (:pushed_at repository))]]))

 (defn- repository-collection
   [repositories]


don't print task namespace warning on 'cake deps'

--- src/cake/task.clj
+++ src/cake/task.clj
@@ -63,7 +63,8 @@
   [namespace]
   (try (require namespace)
        (catch java.io.FileNotFoundException e
-         (when-not (= 'tasks namespace)
+         (when (and (not= 'tasks namespace)
+                    (not= "deps" (first *args*)))
            (println "warning: unable to find tasks namespace" namespace)
            (println "  if you've added a new plugin to :dev-dependencies you must run 'cake deps' to install it"))))
   (into [namespace]