An alternative solution to didibus' business process using missionary.

complex_business_process_example_missionary.clj

(ns complex-business-process-example-missionary
  "A stupid example of a more complex business process to implement as a flowchart."
  (:require [missionary.core :as m])
  (:import missionary.Cancelled))

;;;; Config

(def config
  "When set to :test will trigger the not-boosted branch which won't write to db.
   When set to :prod will trigger the boosted branch which will try to write to the db."
  {:env :prod})

(def chance-of-failure
  "The chances that any db read or write 'times out'.
   1 means there is a 1 in 1 chance a read or write times out, always does.
   2 means there is a 1 in 2 chance a read or write times out.
   3 means there is 1 in 3 chance a read or write times out.
   X means there is 1 in X chance a read or write times out."
  3)

;;;; Fake Databases

(def prod-db
  "Our fake prod db, we pretend it has first-name -> last-name
   mappings and some total of some business thing which is supposed
   to reflect the total of all 'boost' events logged in boost-records.
   This means boost-records and total must always reconcile.
   eg: {john mayer
        jane queen
        :boost-records [{:first-name john, :last-name mayer, :boost 12}]
        :total 12}"
  (atom {"john" "mayer"
         "jane" "queen"
         :boost-records []
         :total 0}))

(def test-db
  "Same as prod db, but is for non prod environments.
   Based on the rules and our example input, it should not be written too, but will
   be read from"
  (atom {"john" "doe"
         "jane" "doee"
         :boost-records []
         :total 0}))

;;;; Utils

(defn prod?
  "[pure] Returns true if end is :prod, false otherwise."
  [env]
  (boolean (#{:prod} env)))

;;;; Validation

(defn valid-bar-input?
  "[pure] Returns true if input is valid for bar processing, false otherwise."
  [input]
  (every? number? (vals input)))

;;;; Pure business logic

(defn apply-credit
  "[pure] Applies given credit using ridiculous business stakeholder requirements."
  [credit env]
  (if (prod? env)
    (inc credit)
    (dec credit)))

(defn apply-bonus-over-credit
  "[pure] Applies given bonus over credit using ridiculous business stakeholder requirements."
  [credit bonus env]
  (if (prod? env)
    (+ 10 credit bonus)
    (- credit bonus 10)))

(defn apply-generous-bonus-over-credit
  "[pure] Applies given generous bonus generously over credit using ridiculous business stakeholder requirements."
  [credit bonus env]
  (if (prod? env)
    (+ 100 credit bonus)
    (- credit bonus 100)))

(defn boost->first-name
  "[pure] Given a boost amount, returns the first-name that should dictate boosting based on
   ridiculous business stakeholder requirements."
  [boost env]
  (if (prod? env)
    (if (pos? boost)
      "john"
      "jane")
    (if (neg? boost)
      "john"
      "jane")))

(defn boost?
  "[pure] Returns true if we should boost based on ridiculous business stakeholder requirements."
  [last-name]
  (if (#{"mayer"} last-name)
    true
    false))

(defn query-get-last-name
  "[pure] Task getting last-name from db for given first-name.
   Can throw based on chance-of-failure setting."
  [db first-name]
  (m/sp
    (when (zero? (rand-int chance-of-failure))
      (throw (ex-info "Timed out getting last-name from db" {:first-name first-name})))
    (m/? (m/sleep 1000))
    (get @db first-name)))

(defn query-get-total
  "[pure] Task getting total from db.
   Can throw based on chance-of-failure setting."
  [db]
  (m/sp
    (when (zero? (rand-int chance-of-failure))
      (throw (ex-info "Timed out getting total from db" {})))
    (m/? (m/sleep 1000))
    (get @db :total)))

(defn query-get-boost-records
  "[pure] Task getting boost records from db.
   Can throw based on chance-of-failure setting."
  [db]
  (m/sp
    (when (zero? (rand-int chance-of-failure))
      (throw (ex-info "Timed out getting boost-records from db" {})))
    (m/? (m/sleep 1000))
    (get @db :boost-records)))

(defn write-total
  "[pure] Task writing total to db, overwrites existing total with given total.
   Can throw based on chance-of-failure setting."
  [db total]
  (m/sp
    (when (zero? (rand-int chance-of-failure))
      (throw (ex-info "Timed out writing total to db" {:total total})))
    (m/? (m/sleep 1000))
    (swap! db assoc :total total)))

(defn write-boost-records
  "[pure] Task writing boost records to db, overwrites existing boost records with given boost records.
   Can throw based on chance-of-failure setting."
  [db boost-records]
  (m/sp
    (when (zero? (rand-int chance-of-failure))
      (throw (ex-info "Timed out writing boost-records to db" {:boost-records boost-records})))
    (m/? (m/sleep 1000))
    (swap! db assoc :boost-records boost-records)))

(def first-or
  "[pure] Task completing with first value produced by flow, or default value if empty."
  (partial m/reduce (comp reduced {})))

;;;; Business Processes

(defn process-bar
  "[pure] Task completing with the result of applying the bar business process on given input, or nil if cancelled.
The structure is mostly the same as in the sequential solution, except we got rid of the loops. Instead, we leverage
backtracking to implement retry logic : when a block needs to be retried, we prepend it with an amb> expression starting
with nil (first attempt is done right away), followed by an arbitrary number of sleeps, then an error (too much
attempts). Code paths leading to retries are marked with (amb>), indicating an absence of result. In this way we define
a flow producing the results of each successive attempt, of which we can extract the first item."
  [input]
  (first-or nil
    (m/ap
      (let [env (:env config)
            db (if (prod? env) prod-db test-db)]
        (try
          (if (valid-bar-input? input)
            (let [credit (apply-credit (:credit input) env)
                  boost (if (pos? credit)
                          (apply-bonus-over-credit credit (:bonus input) env)
                          (apply-generous-bonus-over-credit credit (:generous-bonus input) env))
                  first-name (boost->first-name boost env)]
              (m/amb> nil
                (do (m/? (m/sleep (m/amb> 10 100 1000)))
                    (println "Retrying to query last name after failure."))
                (throw (ex-info "All attempts to query last name failed." {})))
              (let [last-name (try (m/? (query-get-last-name db first-name))
                                   (catch Exception _ (m/amb>)))]
                (if (boost? last-name)
                  (do (m/amb> nil
                        (do (m/? (m/sleep (m/amb> 10 100 1000 1250 1500 2000)))
                            (println "Retrying to update boost-records and total after failure."))
                        (throw (ex-info "All attempts to update boost-records and total failed." {})))
                      (try
                        (let [boost-records (m/? (query-get-boost-records db))
                              total (m/? (query-get-total db))
                              new-boost-record {:first-name first-name
                                                :last-name  last-name
                                                :boost      boost}
                              new-boost-records (conj boost-records new-boost-record)
                              new-total (+ total boost)]
                          (m/? (write-boost-records db new-boost-records))
                          (try (m/? (write-total db new-total))
                               (catch Exception e
                                 (m/amb> nil
                                   (do (m/? (m/sleep (m/amb> 10 100 200)))
                                       (println "Retrying to rollback boost records after updating total, after failing to do so."))
                                   (throw (ex-info "Failed to rollback boost records after updating total, out-of-sync boost record is: " {})))
                                 (try (m/? (write-boost-records db boost-records))
                                      (catch Exception _ (m/amb>)))
                                 (throw e)))
                          (println "Process bar boosted.")
                          {:result :boosted})
                        (catch Exception _ (m/amb>))))
                  (do (println "Process bar did not boost.")
                      {:result :not-boosted}))))
            (do (println "Invalid input passed to bar.")
                {:result :invalid-input :msg "All values of bar input must be numbers"}))
          (catch Cancelled _ (m/amb>))
          (catch Exception e
            (do (println (str "Process bar failed unexpectedly with error: " e))
                {:result :error})))))))

;;;; REPL

(comment
  ;; Run our process to see it go in :prod
  (println
    (m/? (process-bar {:credit         0
                       :bonus          1
                       :generous-bonus 2})))
  ;; Print the db to see if it had the effect we intended to it.
  (println
    (if (prod? (:env config))
      @prod-db
      @test-db))

  ;; Run it with a wrong input
  (println
    (m/? (process-bar {:credit         "0"
                       :bonus          1
                       :generous-bonus 2})))

  ;; Run it again and see what happens to the DB
  (println
    (m/? (process-bar {:credit         2
                       :bonus          12
                       :generous-bonus 23})))
  ;; Print the db to see if it had the effect we intended to it.
  (println
    (if (prod? (:env config))
      @prod-db
      @test-db))

  ;; Change to :test env
  (def config {:env :test})

  ;; Run our process to see it go in :test
  (println
    (m/? (process-bar {:credit         0
                       :bonus          1
                       :generous-bonus 2})))
  ;; Print the db to see if it had the effect we intended to it.
  (println
    (if (prod? (:env config))
      @prod-db
      @test-db)))

It's pretty clear that effect management doesn't have the same meaning for you than for me. Could you help me understanding better your expectations from an effect system ? Even would we end up disagreeing, I'd like to be more explicit about goals and non-goals.

I apologize for the confusion. I was trying to understand missionary's scope because I heard someone saying somewhere that missionary helps with making otherwise impure functions into pure functions, or something along these lines, and that kind of intrigued me.