updated clojure compute binding

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

@@ -27,97 +27,146 @@ See http://code.google.com/p/jclouds for details."
         [clojure.contrib.str-utils2 :only [capitalize lower-case map-str]]
         [clojure.contrib.java-utils :only [wall-hack-field]])
   (:import java.io.File
-           org.jclouds.domain.Location
+           [org.jclouds.domain Location]
+           [org.jclouds.compute
+            ComputeService ComputeServiceContext ComputeServiceContextFactory]
+           [org.jclouds.compute.domain
+            Template TemplateBuilder ComputeMetadata NodeMetadata Size OsFamily
+            Image Architecture]
            org.jclouds.compute.options.TemplateOptions
-           (org.jclouds.compute ComputeService
+           [com.google.common.collect ImmutableSet]))
-                                ComputeServiceContext
+
-                                ComputeServiceContextFactory)
+(defn compute-service
-           (org.jclouds.compute.domain Template TemplateBuilder ComputeMetadata
+  "Create a logged in context."
-                                       NodeMetadata Size OsFamily Image
+  ([#^String service #^String account #^String key & options]
-                                       Architecture)
+     (.. (ComputeServiceContextFactory.)
-           (com.google.common.collect ImmutableSet)))
+         (createContext
+          service account key
+          (apply modules (filter #(not (#{:sync :async} %)) options)))
+         (getComputeService))))
 
 (defn compute-context
-  "Create a logged in context."
+  "Returns a compute context from a compute service."
-  ([service account key]
+  [compute]
-     (compute-context service account key (modules :log4j :ssh :enterprise)))
+  (.getContext compute))
-  ([#^String service #^String account #^String key #^ImmutableSet modules]
+
-     (.createContext (new ComputeServiceContextFactory) service account key modules)))
+(defn compute-service?
+  [object]
+  (instance? ComputeService object))
+
+(defn compute-context?
+  [object]
+  (instance? ComputeServiceContext object))
+
+(defn as-compute-service
+  "Tries hard to produce a compute service from its input arguments"
+  [& args]
+  (cond
+   (compute-service? (first args)) (first args)
+   (compute-context? (first args)) (.getComputeService (first args))
+   :else (apply compute-context args)))
+
+(def *compute*)
+
+(defmacro with-compute-service
+  "Specify the default compute service"
+  [[& compute-or-args] & body]
+  `(binding [*compute* (as-compute-service ~@compute-or-args)]
+     ~@body))
 
 (defn locations
   "Retrieve the available compute locations for the compute context."
-  [#^ComputeServiceContext compute]
+  ([] (locations *compute*))
-  (seq-from-immutable-set (.getLocations (.getComputeService compute))))
+  ([#^ComputeService compute]
+     (seq-from-immutable-set (.getLocations compute))))
 
 (defn nodes
   "Retrieve the existing nodes for the compute context."
-  ([#^ComputeServiceContext compute]
+  ([] (nodes *compute*))
-     (seq-from-immutable-set (.getNodes (.getComputeService compute))))
+  ([compute-or-tag]
-  ([#^ComputeServiceContext compute #^String tag]
+     (if (compute-service? compute-or-tag)
-     (seq-from-immutable-set (.getNodesWithTag (.getComputeService compute) tag))))
+       (seq-from-immutable-set (.getNodes compute-or-tag))
+       (nodes compute-or-tag *compute*)))
+  ([#^String tag #^ComputeService compute]
+     (seq-from-immutable-set (.getNodesWithTag compute tag))))
 
 (defn images
   "Retrieve the available images for the compute context."
-  [#^ComputeServiceContext compute]
+  ([] (images *compute*))
-  (seq-from-immutable-set (.getImages (.getComputeService compute))))
+  ([#^ComputeService compute]
+     (seq-from-immutable-set (.getImages compute))))
 
 (defn sizes
   "Retrieve the available node sizes for the compute context."
-  [#^ComputeServiceContext compute]
+  ([] (sizes *compute*))
-  (seq-from-immutable-set (.getSizes (.getComputeService compute))))
+  ([#^ComputeService compute]
+     (seq-from-immutable-set (.getSizes compute))))
 
-(defn default-template [#^ComputeServiceContext compute]
+(defn default-template
-  (.. compute (getComputeService) (templateBuilder)
+  ([] (default-template *compute*))
-      (osFamily OsFamily/UBUNTU)
+  ([#^ComputeService compute]
-      smallest
+     (.. compute (templateBuilder)
-      (options
+         (osFamily OsFamily/UBUNTU)
-       (org.jclouds.compute.options.TemplateOptions$Builder/authorizePublicKey
+         smallest
-        (slurp (str (. System getProperty "user.home") "/.ssh/id_rsa.pub"))))
+         (options
-      build))
+          (org.jclouds.compute.options.TemplateOptions$Builder/authorizePublicKey
+           (slurp (str (. System getProperty "user.home") "/.ssh/id_rsa.pub"))))
+         build)))
 
 (defn run-nodes
   "Create the specified number of nodes using the default or specified
    template."
-  ([compute tag count]
+  ([tag count]
-     (run-nodes compute tag count (default-template compute)))
+     (run-nodes tag count (default-template *compute*) *compute*))
-  ([#^ComputeServiceContext compute tag count template]
+  ([tag count compute-or-template]
+     (if (compute-service? compute-or-template)
+       (run-nodes
+        tag count (default-template compute-or-template) compute-or-template)
+       (run-nodes tag count compute-or-template *compute*)))
+  ([tag count template #^ComputeService compute]
      (seq-from-immutable-set
-      (.runNodesWithTag
+      (.runNodesWithTag compute tag count template))))
-       (.getComputeService compute) tag count template))))
 
 (defn run-node
   "Create a node using the default or specified template."
-  ([compute tag]
+  ([tag]
-    (run-nodes compute tag 1 (default-template compute)))
+     (run-nodes tag 1 (default-template *compute*) *compute*))
-  ([compute tag template]
+  ([tag compute-or-template]
-     (run-nodes compute tag 1 template)))
+     (if (compute-service? compute-or-template)
+       (run-nodes tag 1 (default-template compute-or-template) compute-or-template)
+       (run-nodes tag 1 compute-or-template *compute*)))
+  ([tag template compute]
+     (run-nodes tag 1 template compute)))
 
 (defn #^NodeMetadata node-details
   "Retrieve the node metadata."
-  [#^ComputeServiceContext compute node]
+  ([node] (node-details node *compute*))
-  (.getNodeMetadata (.getComputeService compute) node ))
+  ([node #^ComputeService compute]
+     (.getNodeMetadata compute node )))
 
 (defn reboot-nodes
   "Reboot all the nodes with the given tag."
-  ([#^ComputeServiceContext compute #^String tag]
+  ([tag] (reboot-nodes tag *compute*))
-    (.rebootNodesWithTag (.getComputeService compute) tag )))
+  ([#^String tag #^ComputeService compute]
+     (.rebootNodesWithTag compute tag )))
 
 (defn reboot-node
   "Reboot a given node."
-  ([#^ComputeServiceContext compute
+  ([node] (reboot-node node *compute*))
-    #^ComputeMetadata node]
+  ([#^ComputeMetadata node #^ComputeService compute]
-    (.rebootNode (.getComputeService compute) node )))
+     (.rebootNode compute node )))
 
 (defn destroy-nodes
   "Destroy all the nodes with the given tag."
-  ([#^ComputeServiceContext compute #^String tag]
+  ([tag] (destroy-nodes tag *compute*))
-    (.destroyNodesWithTag (.getComputeService compute) tag )))
+  ([#^String tag #^ComputeService compute]
+     (.destroyNodesWithTag compute tag )))
 
 (defn destroy-node
   "Destroy a given node."
-  ([#^ComputeServiceContext compute
+  ([node] (destroy-node node *compute*))
-    #^ComputeMetadata node]
+  ([#^ComputeMetadata node #^ComputeServiceContext compute]
-    (.destroyNode (.getComputeService compute) node )))
+     (.destroyNode compute node)))
 
 (defmacro state-predicate [node state]
   `(= (.getState ~node)
@@ -248,8 +297,8 @@ See http://code.google.com/p/jclouds for details."
       (f builder value)
       (println "Unknown option" option))))
 
-(defn build-template [#^ComputeServiceContext compute option & options]
+(defn build-template [#^ComputeService compute option & options]
-  (let [builder (.. compute (getComputeService) (templateBuilder))]
+  (let [builder (.. compute (templateBuilder))]
     (loop [option option
            remaining options]
       (if (empty? remaining)