pallet.action-plan

gistfile1.clj

(ns pallet.action-plan
  "An action plan contains actions for execution.

  It might be possible to unify actions and crate functions, if we can solve
  nested execution of actions (ie. real control flows within the action plan).

  This might be possible by having a `do` action that creates a nested action
  plan."
  {:author "Hugo Duncan"}
  (:require
   [pallet.argument :as argument]
   [clojure.contrib.condition :as condition]
   [clojure.contrib.logging :as logging]
   [clojure.contrib.monads :as monad]
   [clojure.string :as string]
   [clojure.walk :as walk])
  (:use
   [clojure.contrib.def :only [defunbound defvar defvar- name-with-attributes]]
   clojure.contrib.core))

;; The action plan is a stack of actions, where the action could itself
;; be a stack of actions

(defn push-block
  "Push a block onto the action-plan"
  [action-plan]
  (conj (or action-plan '(nil nil)) nil))

(defn pop-block
  "Take the last block and add it to the scope below it in the stack.
   The block is reversed to put it into the order in which elements
   were added. Once pop'd, nothing should be added to the block."
  [action-plan]
  (let [block (peek action-plan)
        stack (pop action-plan)]
    (if-let [stem (next stack)]
      (conj stem (conj (first stack) (reverse block)))
      (if-let [stem (seq (first stack))]
        (conj stem (reverse block))
        (reverse block)))))

(defn add-action
  "Add an action to the plan"
  [action-plan action]
  (let [action-plan (or action-plan '(nil nil))
        block (peek action-plan)
        stack (pop action-plan)]
    (conj stack (conj block action))))

;; pallet specific action

(def
  ^{:doc "set of executions that must be executed locally"
    :private true}
  local-executions
  #{:fn/clojure :transfer/to-local})

(defn action-map
  "Return an action map for the given args"
  [invoke-fn args execution resource-type]
  (let [[execution location] (if (local-executions resource-type)
                               [:in-sequence :local]
                               [execution :remote])]
    {:f invoke-fn
     :args args
     :location location
     :type resource-type
     :execution execution}))

;;; transform executions

(defn- group-by-function
  "Transforms a seq of actions, generally some with identical :f values into a
   sequence of actions where the :args are the concatenation of all of the :args
   of associated with each :f in the original seq.  Sequence order from the
   original seq is retained. Keys over than :f and :args are assumed identical
   for a given :f value.

   e.g. (group-by-function
           [{:f :a :args [1 2]}
            {:f :b :args [3 4]}
            {:f :a :args [5 6]}
            {:f :c :args [7 8]]])
        => ({:f :a :args ([1 2] [5 6])}
            {:f :c :args ([7 8])}
            {:f :b :args ([3 4])})"
  [action-plan]
  (->>
   action-plan
   (group-by :f)
   (map (fn [[_ action-calls]]
          (reduce
           #(update-in %1 [:args] conj (:args %2))
           (assoc (first action-calls) :args [])
           action-calls)))))

(def ^{:doc "Execution specifc transforms" :private true}
  execution-transforms
  {:aggregated [group-by-function]
   :collected [group-by-function]})

(defvar- execution-ordering [:aggregated :in-sequence :collected])

(defn- transform-execution
  [execution action-plan]
  (if-let [transforms (execution-transforms execution)]
    (reduce #(%2 %1) action-plan transforms)
    action-plan))

(defn- transform-executions
  "Sort an action plan into different executions, applying execution specific
   transforms."
  [action-plan]
  (let [executions (group-by :execution action-plan)]
    (mapcat
     #(transform-execution % (% executions))
     execution-ordering)))

;;; enforce precedence
(defn- action-precedence-comparator
  "A comparator for precedence between actions."
  [x y]
  (let [before-fn (fn [f]
                    (let [before (:always-before (meta f))
                          before (if (or (set? before) (nil? before))
                                   before
                                   #{before})
                          before (seq (filter identity (map find-var before)))]
                      (into #{} (map (comp :resource-fn meta) before))))
        fx (:f x)
        fy (:f y)]
    (cond
     ((before-fn fx) fy) -1
     ((before-fn fy) fx) 1
     :else 0)))

(defn- enforce-precedence
  "Enforce precedence relations between actions."
  [action-plan]
  (sort action-precedence-comparator action-plan)) ; sort is order preserving


;;; Bind arguments

(defn- evaluate-args
  "Evaluate an argument sequence"
  [request args]
  (map (fn [arg] (when arg (argument/evaluate arg request))) args))

(defn- apply-action
  "Returns a function that applies args to the function f,
   evaluating the arguments."
  [f args]
  (fn [request]
    (apply f request (evaluate-args request args))))

(defn- apply-aggregated-action
  "Apply args-seq to the function f, evaluating each argument list in args-seq."
  [f args-seq]
  (fn [request]
    (f request (map #(evaluate-args request %) args-seq))))

(defmulti bind-action-arguments
  "Bind an action's arguments."
  (fn [{:keys [execution]}] execution))

(defmethod bind-action-arguments :in-sequence
  [{:keys [f args] :as action-map}]
  (->
   action-map
   (update-in [:f] apply-action args)
   (dissoc :args)))

(defmethod bind-action-arguments :aggregated
  [{:keys [f args] :as action-map}]
  (->
   action-map
   (update-in [:f] apply-aggregated-action args)
   (dissoc :args)))

(defmethod bind-action-arguments :collected
  [{:keys [f args] :as action-map}]
  (->
   action-map
   (update-in [:f] apply-aggregated-action args)
   (dissoc :args)))

(defn- bind-arguments
  "Takes an action plan and binds each actions arguments"
  [action-plan]
  (map bind-action-arguments action-plan))


;;; combine by location and type
(defn- script-join
  "Concatenate multiple scripts, removing blank lines"
  [scripts]
  (str
   (->>
    scripts
    (map #(when % (string/trim %)))
    (filter (complement string/blank?))
    (string/join \newline))
   \newline))

(defmulti combine-actions
  "Combine actions by type"
  (fn [actions] (:type (first actions))))

(defmethod combine-actions :default
  [actions]
  (reduce
   (fn combine-actions-compose [combined action]
     (update-in combined [:f] #(comp (:f action) %)))
   actions))

(defmethod combine-actions :script/bash
  [actions]
  (assoc (first actions)
    :f (fn [request] (script-join (map #((:f %) request) actions)))))

(defn- combine-by-location-and-type
  "Combines bound actions by location and type, producing compound actions"
  [action-plan]
  (->>
   action-plan
   (partition-by (juxt :location :type))
   (map combine-actions)))

;;; augment return
(defmulti augment-return
  "Change the return type of an action, to be an action map with
   :value and :request keys that are the value of the action, and the updated
   request map for the next action.  This creates a consistent return value for
   all action types (effectively creating a monadic value which is a map)."
  (fn [{:keys [type] :as action}] type))

(defmethod augment-return :default
  [{:keys [f] :as action}]
  (assoc action
    :f (fn [request]
         (let [request (f request)]
           (assoc action
             :request request
             :value request)))))

(defmethod augment-return :script/bash
  [{:keys [f] :as action}]
  (assoc action
    :f (fn [request]
         (assoc action
           :request request
           :value (f request)))))

(defn- augment-return-values
  "Augment the return values of each action"
  [action-plan]
  (map augment-return action-plan))

;;; translate action plan
(defn translate
  "Process the action-plan, applying groupings and precedence, producing
   an action plan with fully bound functions, ready for execution."
  [action-plan]
  (->
   action-plan
   pop-block ;; pop the default block
   transform-executions
   enforce-precedence
   bind-arguments
   combine-by-location-and-type
   augment-return-values))


;;; execute action plan
(defn execute-action
  "Execut a single action"
  [executor [result request] {:keys [f type] :as action}]
  (swank.core/break)
  (let [executor-f (executor type)
        {:keys [request value]} (f request)]
    [(conj result (executor-f value)) request]))

(defn execute
  "Execute actions by passing the evaluated actions to the function of the
   correct type in `executor` (a map of functions keyed by action type)."
  [action-plan request executor]
  (swank.core/break)
  (reduce #(execute-action executor %1 %2) [[] request] action-plan))