Clojure 函数式设计模式：组合子、解释器与 Monad 实战

;; 命令 = 描述操作的数据
(defn create-command [op payload]
  {:op op :payload payload :ts (System/currentTimeMillis)})

;; 命令执行器：集中分发
(defmulti execute (fn [cmd] (:op cmd)))

(defmethod execute :user-create [{:keys [payload] :as cmd}]
  (let [user (jdbc/insert! :users payload)]
    (log/info "user created" (:id user))
    user))

(defmethod execute :user-delete [{:keys [payload]}]
  (jdbc/delete! :users {:id (:id payload)})
  nil)

;; 命令队列：可持久化、可重放、可审计
(defn enqueue! [db cmd]
  (jdbc/insert! db :command_queue {:payload (pr-str cmd)}))

;; 回放全部命令，重建最终状态
(defn replay [db user-id]
  (reduce
    (fn [state cmd] (execute cmd))
    initial-state
    (jdbc/query db ["select payload from command_queue
                     where user_id = ? order by ts" user-id])))

;; 一个简单的规则 DSL：用嵌套 vector 描述规则
(def rule
  [:and
   [:> [:field :order_amount] 100]
   [:or
    [:= [:field :payment_method] "wxpay"]
    [:contains? [:field :tags] :promo]]])

;; 规则求值器：解释器模式
(defmulti eval-rule (fn [node _ctx] (first node)))

(defmethod eval-rule :and [[_ & clauses] ctx]
  (every? #(eval-rule % ctx) clauses))

(defmethod eval-rule :or [[_ & clauses] ctx]
  (some #(eval-rule % ctx) clauses))

(defmethod eval-rule :> [[_ lhs rhs] ctx]
  (> (eval-rule lhs ctx) (eval-rule rhs ctx)))

(defmethod eval-rule :field [[_ k] ctx]
  (get-in ctx k))

;; 使用：把 DSL 从「字符串规则」变成「可执行判定」
(eval-rule rule {:order_amount 150 :payment_method "wxpay" :tags [:promo]})
;; => true

;; 排序/校验/定价策略都只是函数
(defn price-rule:standard [base] base)
(defn price-rule:vip [[discount _] base] (* base discount))
(defn price-rule:promo [{:keys [promo]} base] (* base (- 1 promo)))

;; 把策略作为参数传入
(defn checkout
  [{:keys [price-strategy] :as config} cart user]
  (let [base (reduce + (map :price cart))]
    (price-strategy user base)))

;; 通用「重试」骨架，让调用方注入每一步的策略
(defn retry*
  [{:keys [attempts delay should-retry on-exhausted]} f]
  (loop [n attempts]
    (let [res (try {:ok (f)}
                   (catch Exception e {:err e}))]
      (cond
        (:ok res) (:ok res)
        (and (> n 1) (should-retry res)) (do (Thread/sleep delay)
                                             (recur (dec n)))
        :else (on-exhausted res)))))

;; 用法：注入超时与退避策略
(retry* {:attempts 3
         :delay 200
         :should-retry #(= 429 (:status (:err %)))
         :on-exhausted (fn [{:keys [err]}] (throw err))}
        #(http/post "https://api.example.com/order" {:body order}))

;; 极简 Either：[:ok v] / [:err e]
(defn safe-divide [a b]
  (if (zero? b) [:err {:msg "division by zero"}]
      [:ok (/ a b)]))

;; 组合：任何一个环节失败，整条链短路
(defn pipeline [a b]
  (let [[s1 v1] (safe-divide a b)
        [s2 v2] (if (= s1 :err) [:err v1] (safe-divide 100 v1))]
    (if (= s2 :err) [:err v2] [:ok v2])))

(pipeline 10 2)  ; => [:ok 50]
(pipeline 10 0)  ; => [:err {:msg "division by zero"}]

(some-> (get-user id)          ; 用户可能不存在
        :profile                ; profile 可能为空
        :settings
        (get :notify)
        (update :email-count inc))
;; 任一步 nil → 整体 nil

;; 用 let 表达 Maybe 的组合语义
(defn get-order-email [order-id]
  (let [order   (find-order order-id)          ; Maybe Order
        user-id (some-> order :user-id)        ; 短路
        user    (find-user user-id)
        email   (some-> user :email)]
    email))

;; 基础组合子
(defn between? [lo hi x] (and (>= x lo) (<= x hi)))
(defn either [a b] (fn [x] (or (a x) (b x))))
(defn all [& preds] (fn [x] (every? #(% x) preds)))
(defn negate [pred] (fn [x] (not (pred x))))

;; 领域词汇表
(def adult?    (between? 18 120))
(def teen?     (between? 13 17))
(def senior?   (between? 60 120))
(def valid-age (either teen? senior?))

;; 组合出复杂校验
(def ok? (all adult? (negate senior?) #(even? (:order-count %))))