Add clojure interface for spot instances

Add clojure template-builder keywords for spot instances introduced
for issue #308.  Add a builder for spot-options.

compute/src/main/clojure/org/jclouds/compute.clj

@@ -1,6 +1,6 @@
 ;
 ;
-; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com>
+; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
 ;
 ; ====================================================================
 ; Licensed under the Apache License, Version 2.0 (the "License");
@@ -23,8 +23,8 @@
 Current supported providers are:
    [aws-ec2, eucualyptus-partnercloud-ec2, elastichosts-lon-b,
     cloudservers-uk, cloudservers-us, byon, cloudsigma-zrh, stub,
-    trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus, 
-    slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts, 
+    trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus,
+    slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts,
     openhosting-east1, serverlove-z1-man, skalicloud-sdg-my]
 
 Here's an example of getting some compute configuration from rackspace:
@@ -372,50 +372,51 @@ See http://code.google.com/p/jclouds for details."
 (define-accessors Hardware processors ram volumes)
 (define-accessors NodeMetadata "node" credentials hardware state group)
 
-(defn builder-options [builder]
-  (or
-   (get-field
-    org.jclouds.compute.domain.internal.TemplateBuilderImpl :options builder)
-   (TemplateOptions.)))
+(def
+  ^{:doc "TemplateBuilder functions" :private true}
+  template-map
+  (merge
+   (make-option-map
+    kw-memfn-0arg [:smallest :fastest :biggest :any])
+   (make-option-map
+    kw-memfn-1arg
+    [:os-family :location-id :architecture :image-id :hardware-id
+     :os-name-matches :os-version-matches :os-description-matches
+     :os-64-bit :image-version-matches :image-name-matches
+     :image-description-matches :min-cores :min-ram])))
 
-(defmacro option-option-fn-0arg [key]
-  `(fn [builder#]
-     (let [options# (builder-options builder#)]
-       (~(symbol (str "." (camelize-mixed (name key)))) options#)
-       (.options builder# options#))))
+(def
+  ^{:doc "TemplateOptions functions" :private true}
+  options-map
+  (merge
+   (make-option-map
+    kw-memfn-0arg
+    [:destroy-on-error :enable-monitoring :no-placement-group :no-key-pair
+     :with-details])
+   (make-option-map
+    kw-memfn-1arg
+    [:run-script :install-private-key :authorize-public-key
+     ;; aws ec2 options
+     :spot-price :spot-options :placement-group :subnet-id
+     :block-device-mappings :unmapDeviceNamed :security-groups
+     :key-pair :user-data])
+   (make-option-map kw-memfn-varargs [:inbound-ports])
+   (make-option-map
+    kw-memfn-2arg
+    [:block-on-port
+     ;; aws ec2 options
+     :map-ephemeral-device-to-device-name])
+   {:map-ebs-snapshot-to-device-name
+    (kw-memfn-apply :map-ebs-snapshot-to-device-name
+                    device-name snapshot-id size-in-gib delete-on-termination)
+    :map-new-volume-to-device-name
+    (kw-memfn-apply :map-new-volume-to-device-name
+                    device-name size-in-gib delete-on-termination)}))
 
-(defn- seq-to-array [args]
-  (if (or (seq? args) (vector? args))
-    (int-array args)
-    args))
-
-(defmacro option-option-fn-1arg [key]
-  `(fn [builder# value#]
-     (let [options# (builder-options builder#)]
-       (~(symbol (str "." (camelize-mixed (name key))))
-        options# (seq-to-array value#))
-       (.options builder# options#))))
-
-(def option-1arg-map
-  (apply array-map
-         (concat
-          (make-option-map
-           option-fn-1arg
-           [:os-family :location-id :architecture :image-id :hardware-id
-            :os-name-matches :os-version-matches :os-description-matches
-            :os-64-bit :image-version-matches :image-name-matches
-            :image-description-matches :min-cores :min-ram])
-          (make-option-map
-           option-option-fn-1arg
-           [:run-script :install-private-key :authorize-public-key
-            :inbound-ports]))))
-(def option-0arg-map
-     (apply hash-map
-            (concat
-             (make-option-map option-fn-0arg
-                              [:smallest :fastest :biggest :any])
-             (make-option-map option-option-fn-0arg
-                              [:destroy-on-error]))))
+(def
+  ^{:doc "All receognised options"}
+  known-template-options
+  (set (mapcat keys [options-map template-map])))
 
 (defn os-families []
   (. OsFamily values))
@@ -426,14 +427,8 @@ See http://code.google.com/p/jclouds for details."
   (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first)
       value))
 
-(defn add-nullary-option [builder option value]
-  (if-let [f (option-0arg-map option)]
-    (if value
-      (f builder)
-      builder)))
-
-(defn add-value-option [builder option value]
-  (if-let [f (option-1arg-map option)]
+(defn apply-option [builder option-map option value]
+  (when-let [f (option-map option)]
     (f builder (translate-enum-value option value))))
 
 ;; TODO look at clojure-datalog
@@ -457,10 +452,31 @@ Options correspond to TemplateBuilder methods."
     :as options}]
   (let [builder (.. compute (templateBuilder))]
     (doseq [[option value] options]
-      (or
-       (add-value-option builder option value)
-       (add-nullary-option builder option value)
-       (condition/raise
-        :type :invalid-template-builder-option
-        :message (format "Invalid template builder option : %s" option))))
-    (.build builder)))
+      (when-not (known-template-options option)
+        (condition/raise
+         :type :invalid-template-builder-option
+         :message (format "Invalid template builder option : %s" option)))
+      ;; apply template builder options
+      (try
+        (apply-option builder template-map option value)
+        (catch Exception e
+            (condition/raise
+             :type :invalid-template-builder
+             :message (format
+                       "Problem applying template builder %s with value %s: %s"
+                       option (pr-str value) (.getMessage e))
+             :cause e))))
+    (let [template (.build builder)
+          template-options (.getOptions template)]
+      (doseq [[option value] options]
+        ;; apply template option options
+        (try
+          (apply-option template-options options-map option value)
+          (catch Exception e
+            (condition/raise
+             :type :invalid-template-option
+             :message (format
+                       "Problem applying template option %s with value %s: %s"
+                       option (pr-str value) (.getMessage e))
+             :cause e))))
+      template)))

core/src/main/clojure/org/jclouds/core.clj

@@ -1,6 +1,6 @@
 ;
 ;
-; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com>
+; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
 ;
 ; ====================================================================
 ; Licensed under the Apache License, Version 2.0 (the "License");
@@ -65,32 +65,130 @@ Ensure the module is on the classpath.  You are maybe missing a dependency on
                                  :else %)
                                modules)))))
 
+;;; Functions and macros to map keywords to java member functions
 (defn dashed [a]
-  (apply str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a)))))
+  (apply
+   str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a)))))
 
-(defn camelize [a]
-  (string/map-str string/capitalize (.split a "-")))
+(defn camelize
+  "Takes a string, or anything named, and converts it to camel case
+   (capitalised initial component"
+  [a]
+  (string/map-str string/capitalize (.split (name a) "-")))
 
-(defn camelize-mixed [a]
-  (let [c (.split a "-")]
+(defn camelize-mixed
+  "Takes a string, or anything named, and converts it to mixed camel case
+   (lower case initial component)"
+  [a]
+  (let [c (.split (name a) "-")]
     (apply str (string/lower-case (first c)) (map string/capitalize (rest c)))))
 
-(defmacro option-fn-0arg [key]
-  `(fn [builder#]
-     (~(symbol (str "." (camelize-mixed (name key)))) builder#)))
+(defn kw-fn-symbol
+  "Converts a keyword into a camel cased symbol corresponding to a function
+   name"
+  [kw]
+  (symbol (camelize-mixed kw)))
 
-(defmacro option-fn-1arg [key]
-  `(fn [builder# value#]
-     (~(symbol (str "." (camelize-mixed (name key)))) builder# value#)))
+(defmacro kw-memfn
+  "Expands into code that creates a function that expects to be passed an
+   object and any args, and calls the instance method corresponding to
+   the camel cased version of the passed keyword, passing the arguments."
+  [kw & args]
+  `(memfn ~(kw-fn-symbol kw) ~@args))
 
-(defmacro make-option-map [f keywords]
-  `[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)])
+(defmacro kw-memfn-apply
+  "Expands into code that creates a function that expects to be passed an object
+   and an arg vector containing the args, and calls the instance method
+   corresponding to the camel cased version of the passed keyword, passing the
+   arguments."
+  [kw & args]
+  `(fn [target# [~@args]]
+     ((memfn ~(kw-fn-symbol kw) ~@args) target# ~@args)))
+
+(defmacro kw-memfn-0arg
+  "Expands into code that creates a function that expects to be passed an
+   object, and calls the instance method corresponding to the camel cased
+   version of the passed keyword if the argument is non-nil."
+  [kw]
+  `(fn [target# arg#]
+     (if arg#
+       ((kw-memfn ~kw) target#)
+       target#)))
+
+(defmacro kw-memfn-1arg
+  "Expands into code that creates a function that expects to be passed an object
+   and an arg, and calls the instance method corresponding to the camel cased
+   version of the passed keyword, passing the argument."
+  [kw]
+  `(kw-memfn ~kw a#))
+
+(defmacro kw-memfn-2arg
+  "Expands into code that creates a function that expects to be passed an object
+   and an arg vector containing 2 args, and calls the instance method
+   corresponding to the camel cased version of the passed keyword, passing the
+   arguments."
+  [kw]
+  `(kw-memfn-apply ~kw a# b#))
+
+;; (defmacro memfn-overloads
+;;   "Construct a function that applies arguments to the given member function."
+;;   [name]
+;;   `(fn [target# args#]
+;;     (condp = (count args#)
+;;       0 (. target# (~name))
+;;       1 (. target# (~name (first args#)))
+;;       2 (. target# (~name (first args#) (second args#)))
+;;       3 (. target# (~name (first args#) (second args#) (nth args# 2)))
+;;       4 (. target#
+;;            (~name (first args#) (second args#) (nth args# 2) (nth args# 3)))
+;;       5 (. target#
+;;            (~name (first args#) (second args#) (nth args# 2) (nth args# 3)
+;;                   (nth args# 4)))
+;;       (throw
+;;        (java.lang.IllegalArgumentException.
+;;         (str
+;;          "too many arguments passed.  Limit 5, passed " (count args#)))))))
+
+;; (defmacro kw-memfn-overloads
+;;   "Expands into code that creates a function that expects to be passed an
+;;    object and an arg vector, and calls the instance method corresponding to
+;;    the camel cased version of the passed keyword, passing the arguments.
+;;    The function accepts different arities at runtime."
+;;   [kw]
+;;   `(memfn-overloads ~(kw-fn-symbol kw)))
+
+(defmacro memfn-varargs
+  "Construct a function that applies an argument sequence to the given member
+   function, which accepts varargs. array-fn should accept a sequence and
+   return a suitable array for passing as varargs."
+  [name array-fn]
+  `(fn [target# args#]
+     (. target#
+        (~name
+         (if (or (seq? args#) (vector? args#)) (~array-fn args#) args#)))))
+
+(defmacro kw-memfn-varargs
+  "Expands into code that creates a function that expects to be passed an
+   object and an arg vector, and calls the instance method corresponding to
+   the camel cased version of the passed keyword, passing the arguments.
+   The function accepts different arities at runtime."
+  ([kw] `(kw-memfn-varargs ~kw int-array))
+  ([kw array-fn] `(memfn-varargs ~(kw-fn-symbol kw) ~array-fn)))
+
+(defmacro make-option-map
+  "Builds a literal map from keyword, to a call on macro f with the keyword
+   as an argument."
+  [f keywords]
+  `(hash-map
+    ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)))
 
 (defmacro define-accessor
   [class property obj-name]
   (list 'defn (symbol (str obj-name "-" (name property)))
         (vector  (with-meta (symbol obj-name) {:tag (.getName class)}))
-        (list (symbol (str ".get" (camelize (name property)))) (symbol obj-name))))
+        (list
+         (symbol (str ".get" (camelize (name property))))
+         (symbol obj-name))))
 
 (defmacro define-accessors
   "Defines read accessors, modelled on class-name-property-name.  If the second

core/src/test/clojure/org/jclouds/core_test.clj

@@ -1,6 +1,6 @@
 ;
 ;
-; Copyright (C) 2010 Cloud Conscious, LLC. <info@cloudconscious.com>
+; Copyright (C) 2010, 2011 Cloud Conscious, LLC. <info@cloudconscious.com>
 ;
 ; ====================================================================
 ; Licensed under the Apache License, Version 2.0 (the "License");
@@ -18,8 +18,9 @@
 ;
 
 (ns org.jclouds.core-test
-  (:use [org.jclouds.core] :reload-all)
-  (:use clojure.test))
+  (:use
+   org.jclouds.core
+   clojure.test))
 
 (defmacro with-private-vars [[ns fns] & tests]
   "Refers private fns from ns and runs tests in context.  From users mailing
@@ -50,3 +51,25 @@ list, Alan Dipert and MeikelBrandmeyer."
             (assoc module-lookup
               :non-existing 'this.doesnt.Exist)]
     (is (.isEmpty (modules :non-existing)))))
+
+(deftest kw-fn-symbol-test
+  (is (= 'aB (kw-fn-symbol :a-b))))
+
+(deftest kw-memfn-test
+  (is (= "a" ((kw-memfn :to-lower-case) "A")))
+  (is (= "Ab" ((kw-memfn :concat s) "A" "b")))
+  (is (= "Ab" ((kw-memfn-apply :concat s) "A" ["b"])))
+  (is (= "Ac" ((kw-memfn-apply :replace a b) "Ab" ["b" "c"]))))
+
+(deftest kw-memfn-0arg-test
+  (is (= "a" ((kw-memfn-0arg :to-lower-case) "A" true)))
+  (is (= "A" ((kw-memfn-0arg :to-lower-case) "A" nil))))
+
+(deftest kw-memfn-1arg-test
+  (is (= "Ab" ((kw-memfn-1arg :concat) "A" "b"))))
+
+(deftest kw-memfn-2arg-test
+  (is (= "Ac" ((kw-memfn-2arg :replace) "Ab" ["b" "c"]))))
+
+(deftest kw-memfn-varargs-test
+  (is (fn? (kw-memfn-varargs :replace))))

providers/aws-ec2/src/main/clojure/org/jclouds/aws/ec2.clj

@@ -0,0 +1,45 @@
+(ns org.jclouds.aws.ec2
+  "AWS EC2 specific functionality"
+  (:require
+   [org.jclouds.core :as core])
+  (:import
+   org.jclouds.aws.ec2.domain.SpotInstanceRequest
+   org.jclouds.aws.ec2.options.RequestSpotInstancesOptions))
+
+(def
+  ^{:doc "TemplateBuilder functions" :private true}
+  spot-option-map
+  (core/make-option-map
+   core/kw-memfn-1arg
+   [:valid-from :valid-until :type :launch-group :availability-zone-group]))
+
+(defn spot-types []
+  (. org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type values))
+
+(def enum-map {:type (spot-types)})
+
+(defn translate-enum-value [kword value]
+  (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first)
+      value))
+
+(defn apply-option
+  [options [option value]]
+  (when-let [f (spot-option-map option)]
+    (f options (translate-enum-value option value)))
+  options)
+
+(defn spot-options
+  "Build a spot request options object, for passing to the :spot-options
+   key of the template builder options.
+
+   Takes a hash-map of keys and values that correspond to the methods of
+   RequestSpotInstancesOptions.
+
+   Options are:
+       :valid-from :valid-until :type :launch-group :availability-zone-group
+
+   :type takes either :one-time or :persistent"
+  [request-map]
+  (reduce
+   apply-option
+   (RequestSpotInstancesOptions.) request-map))

providers/aws-ec2/src/test/clojure/org/jclouds/aws/ec2_test.clj

@@ -0,0 +1,15 @@
+(ns org.jclouds.aws.ec2-test
+  (:use
+    org.jclouds.aws.ec2
+    clojure.test))
+
+(deftest translate-enum-value-test
+  (is (= org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type/ONE_TIME
+         (org.jclouds.aws.ec2/translate-enum-value :type :one-time))))
+
+(deftest spot-options-est
+  (is (spot-options {:type :one-time
+                     :valid-from (java.util.Date.)
+                     :valid-until (java.util.Date.)
+                     :launch-group "lg"
+                     :availability-zone-group "ag"})))