com.andrewmcveigh/workflows

0.2.0


Workflow Schema and engine

dependencies

org.clojure/clojure
1.6.0
prismatic/schema
0.3.1



(this space intentionally left almost blank)
 
(ns workflows.core
  (:require
   [clojure.walk :refer [postwalk]]
   [schema.core :as s]
   [workflows.internal.core :refer [defrecordfn]]))
(defrecordfn TFn [form f]
  (fn [_ & args] (apply f args)))
(defmethod print-dup TFn [o w]
  (.write w (pr-str (:form o))))
(defmethod print-method TFn [o w]
  (.write w (pr-str (:form o))))
(defn qualify [s]
  (when-let [m (some-> (resolve s) (meta))]
    (list 'quote (symbol (str (:ns m)) (name (:name m))))))
(defn task-fn* [args form]
  (postwalk (fn [f]
              (cond (symbol? f) (if (args f) `'~f (or (qualify f) f))
                    (list? f) (cons 'list f)
                    :else f))
            form))
(defmacro task-fn [args & forms]
  `(->TFn (list `task-fn '~args ~@(task-fn* (set args) forms))
          (fn ~args ~@forms)))
(def Fn (s/pred fn? 'fn?))
(def Task
  {(s/required-key ::work) (s/either Fn TFn)
   (s/optional-key ::wait) (s/either Fn TFn)})
(def Workflow
  {(s/required-key :position) s/Int
   (s/required-key :flow) [Task]
   (s/required-key :state) s/Any
   (s/optional-key :waiting?) s/Bool})
(s/defn ^:always-validate workflow :- Workflow [init-state & tasks :- [Task]]
  {:position 0 :state init-state :flow (vec tasks)})
(defn task
  ([wait work]
     (merge (when wait {::wait wait}) {::work work}))
  ([work]
     (task nil work)))
(defn complete? [{:keys [position flow] :as workflow}]
  (>= position (count flow)))
(s/defn ^:always-validate work :- Workflow
  "Put a Workflow to work, or restart a waiting Workflow. & args are
expected to be required only by the :waiting? ::work (fn [arg1 arg2 ...])."
  [workflow :- Workflow & args]
  (loop [{:keys [position state flow waiting?] :as workflow} workflow]
    (if (complete? workflow)
      workflow
      (let [{:keys [::wait ::work] :as task} (flow position)]
        (if (and wait (not waiting?))
          (assoc workflow :state (wait state) :waiting? true)
          (recur
           (-> workflow
               (dissoc :waiting?)
               (assoc :state (apply work state (or (and waiting? args) [])))
               (update-in [:position] inc))))))))
 

Adapted from https://gist.github.com/devn/c52a7f5f7cdd45d772a9

(ns workflows.internal.core)
(defn gen-nonvariadic-invokes [f]
  (for [arity (range 1 21),
        :let [args (repeatedly arity gensym)]]
    `(~'invoke [~@args] (~f ~@args))))
(defn gen-variadic-invoke [f]
  (let [args (repeatedly 22 gensym)]
    `(~'invoke [~@args] (apply ~f ~@args))))
(defn gen-apply-to [f]
  `(~'applyTo [this# args#] (apply ~f this# args#)))
(defn extend-IFn [f]
  `(clojure.lang.IFn
    ~@(gen-nonvariadic-invokes f)
    ~(gen-variadic-invoke f)
    ~(gen-apply-to f)))

Like defrecord, but accepts a function f before any specs that is used to implement clojure.lang.IFn. f should accept at least one argument, 'this'.

(defmacro defrecordfn
  [name [& fields] f & opts+specs]
  `(defrecord ~name [~@fields]
     ~@(extend-IFn f)
     ~@opts+specs))