actions.clj

(ns clojurecast.actions
  (:require [clojure.pprint :as pp]
            [clojure.string :as str]
            [clojure.tools.logging :as log]
            [com.stuartsierra.dependency :as dep]))

(def ^:dynamic *action-lists*
  (ref {}))

(def ^:dynamic *handle-existing-action-list*
  [:warn :skip])

(def ^:dynamic *handle-existing-action-in-action-list*
  [:warn :redefine])

(def ^:dynamic *handle-missing-action-list*
  :error)

(def ^:dynamic *handle-missing-action-in-action-list*
  :warn)

(def ^:dynamic *default-action-list-sort-time*
  :execute)

(declare sorted-actions)

(def ^:dynamic *default-execution-function*
  (fn [action-list args]
    (reduce (fn [retvals action]
              (let [retval (if (and (:once action) (realized? (:once action)))
                             @(:once action)
                             (apply (:data action) args))]
                (when (and (:once action) (not (realized? (:once action))))
                  (deliver (:once action) retval))
                (cond
                  (reduced? retval) retval
                  (nil? retval) retvals
                  :else (conj retvals retval))))
            []
            (sorted-actions action-list))))

(defn make-unregistered-action-list
  "Makes an unregistered action list."
  [{:keys [doc sort-time dummy-actions default-order execution-function]
    :as action-list}]
  (cond-> (assoc action-list
                 :actions (ref {})
                 :sorted-actions (ref [])
                 :graph (ref (dep/graph)))
    (nil? sort-time)
    (assoc :sort-time *default-action-list-sort-time*)
    (nil? execution-function)
    (assoc :execution-function *default-execution-function*)
    (nil? dummy-actions)
    (assoc :dummy-actions #{:start :end})
    (nil? default-order)
    (assoc :default-order {:after [:start] :before [:end]})))

(defn- add-new-action-list
  [action-lists name action-list]
  (dosync
    (commute action-lists
             assoc name
             (make-unregistered-action-list (assoc action-list :name name)))))

(defn- redefine-existing-action-list
  [action-lists name action-list]
  (let [[log-op def-op] *handle-existing-action-list*]
    (case log-op
      :warn (log/warn :redefining-action-list name)
      :silent nil)
    (case def-op
      :skip action-lists
      :redefine (add-new-action-list action-lists name action-list))))

(defn- add-action-list
  [action-lists name action-list]
  (if (contains? @action-lists name)
    (redefine-existing-action-list action-lists name action-list)
    (add-new-action-list action-lists name action-list)))

(defn- find-action-list
  [name-or-list]
  (if (map? name-or-list)
    name-or-list
    (get @*action-lists* name-or-list)))

(defn define-action-list
  "Defines a named action list."
  [name & {:keys [doc sort-time dummy-actions default-order execution-function]
           :as action-list}]
  (add-action-list *action-lists* name action-list))

(defn- handle-missing-action-list
  [name-or-list]
  (case *handle-missing-action-list*
    :error (throw (ex-info "Missing action list."
                           {:missing-action-list name-or-list}))
    :warn (log/warn :missing-action-list name-or-list)
    :ignore nil))

(defn undefine-action-list
  "Removes the named action list."
  [name]
  (if-let [action-list (find-action-list name)]
    (dosync
      (commute *action-lists* dissoc name))
    (handle-missing-action-list name)))

(defn actions
  "Returns a vector of actions for the action list."
  [name-or-list]
  (when-let [action-list (find-action-list name-or-list)]
    @(:actions action-list)))

(defn- sort-actions
  [action-list]
  (into []
        (comp
          (remove (:dummy-actions action-list))
          (map #(get @(:actions action-list) %)))
        (dep/topo-sort @(:graph action-list))))

(defn- sorted-actions
  [action-list]
  (if (= (:sort-time action-list) :execute)
    (sort-actions action-list)
    @(:sorted-actions action-list)))

(defn- get-default-before
  [action-list]
  (get-in action-list [:default-order :before]))

(defn- get-default-after
  [action-list]
  (get-in action-list [:default-order :after]))

(defn- add-new-action
  [action-list action-name data specs]
  (dosync
    (commute (:actions action-list) assoc action-name
             {:name action-name
              :data data
              :once (when (:once specs)
                      (promise))})
    (doseq [before (:before specs (get-default-before action-list))]
      (commute (:graph action-list) dep/depend before action-name))
    (doseq [after (:after specs (get-default-after action-list))]
      (commute (:graph action-list) dep/depend action-name after))
    (ref-set (:sorted-actions action-list) (sort-actions action-list))))

(defn- redefine-existing-action
  [actions action-name data specs]
  (let [[log-op def-op] *handle-existing-action-in-action-list*]
    (case log-op
      :warn (log/warn :redefining-action action-name)
      :silent nil)
    (case def-op
      :skip actions
      :redefine (add-new-action actions action-name data specs))))

(defn- add-action
  [action-list action-name data specs]
  (if (and (contains? @(:actions action-list) action-name)
           (not (:force specs)))
    (redefine-existing-action action-list action-name data specs)
    (add-new-action action-list action-name data specs)))

(defn- find-action
  [name-or-list action-name]
  (get (actions name-or-list) action-name))

(defn define-action
  "Adds a new action to a specified list."
  [name-or-list action-name data & {:as specs}]
  (if-let [action-list (find-action-list name-or-list)]
    (add-action action-list action-name data specs)
    (handle-missing-action-list name-or-list)))

(defn undefine-action
  "Removes an action from a specified list."
  [name-or-list action-name]
  (if-let [action-list (find-action-list name-or-list)]
    (dosync
      (commute (:actions (find-action-list name-or-list))
               dissoc action-name))
    (handle-missing-action-list name-or-list)))

(defn execute-actions
  "Executes in sequence the actions on a given list."
  [name-or-list & args]
  (if-let [{:keys [execution-function]
            :as action-list} (find-action-list name-or-list)]
    (execution-function action-list args)
    (handle-missing-action-list name-or-list)))

(defn print-actions
  "Prints a listing of the action items on a given action list in order."
  [name-or-list]
  (io!
    (if-let [action-list (find-action-list name-or-list)]
      (pp/print-table [:name :doc] (vals @(:actions action-list)))
      (handle-missing-action-list name-or-list))))

(defn print-action-lists
  "Prints a list of all the action lists in the global registry."
  []
  (io!
    (doseq [[name action-list] @*action-lists*]
      (prn name)
      (println "        " (:doc action-list))
      (newline))))

(define-action-list "Clojure startup"
  :doc "Actions to run when Clojure starts up.")

(define-action-list "Clojure shutdown"
  :doc "Actions to run when Clojure shuts down.")

(define-action-list "System start"
  :doc "Actions to run when the system starts.")

(define-action-list "System stop"
  :doc "Actions to run when the system stops.")

(define-action-list "Service start"
  :doc "Actions to run when a service starts.")

(define-action-list "Service stop"
  :doc "Actions to run when a service stops.")

(define-action "Clojure startup" :a
  (fn []
    2))

(define-action "Clojure startup" :b
  (fn []
    0)
  :before [:a])

(define-action "Clojure startup" :c
  (fn []
    1)
  :after [:b]
  :before [:a])

(define-action "Clojure startup" :d
  (fn []
    -1)
  :before [:b]
  :once true)