Playing around with specs in malli

malli_play.clj

(ns us.chouser.malli-play
  (:require [malli.core :as m]
            [malli.error :as me])
  (:import (clojure.lang ExceptionInfo)))

;; {:deps {metosin/malli {:mvn/version "0.10.1"}}}
;; No refinement chaining yet
;; No clear separation of constraint violation from runtime error

(defn var-sym [v]
  (symbol (str (ns-name (.ns v)))
          (str (.sym v))))

(defn check
  "Return inst if valid, otherwise throw"
  [inst]
  (let [{:keys [typevar schema]} (deref (:type inst))]
    (if (m/validate schema inst)
      inst
      (let [e (m/explain schema inst)
            h (me/humanize e)]
        (throw (ex-info (format "Invalid %s: %s" (var-sym typevar) (pr-str h))
                        {:explain e
                         :humanized h}))))))

(defn refine-to [inst to-var]
  (let [{:keys [refines-to]} (deref (:type inst))]
    (if-let [f (refines-to to-var)]
      (f inst)
      (throw (ex-info (format "No refinement defined from %s to %s"
                              (var-sym (:type inst)) (var-sym to-var))
                      {:from (var-sym (:type inst))
                       :to (var-sym to-var)})))))

(defn spec-schema [{:keys [fields constraints refines-to]}]
  (m/schema
   (into
    [:and
     (->> fields
          (into [:map {:closed true}
                 [:type [:fn {:error/message "must be a var"} var?]]]))]
    (concat
     (->> constraints
          (map (fn [[msg f]]
                 [:fn {:error/message [:failed-constraint msg]}
                  f])))
     (->> refines-to
          (remove (comp :extrinsic meta val))
          (map (fn [[to-var f]]
                 [:fn {:error/fn (fn [{:keys [value] :as a} b]
                                   [:failed-refinement to-var
                                    (try (check (f value))
                                         (catch ExceptionInfo ex
                                           (:humanized (ex-data ex))))])}
                  (fn [from-inst]
                    (check (f from-inst)))])))))))

(defmacro defspec [typesym spec]
  `(def ~typesym
     (let [spec# ~(assoc spec :typevar (list 'var typesym))]
       (assoc spec# :schema (spec-schema spec#)))))

;;===

(defspec State
  {:fields [[:balance decimal?]
            [:beverageCount int?]
            [:snackCount int?]]
   :constraints [["balance not negative" #(>= (:balance %) 0.00M)]
                 ["counts below capacity" #(and (<= (:beverageCount %) 20)
                                                (<= (:snackCount %) 20))]
                 ["counts not negative" #(and (>= (:beverageCount %) 0)
                                              (>= (:snackCount %) 0))]]})

(check {:type #'State
        :balance 2.00M
        :beverageCount 10
        :snackCount 5})

(defspec InitialState
  {:fields [[:balance decimal?]
            [:beverageCount int?]
            [:snackCount int?]]
   :constraints [["initial state" #(and (= (:balance %) 0.00M)
                                        (= (:beverageCount %) 0)
                                        (= (:snackCount %) 0))]]
   :refines-to {#'State ^:instrinsic #(assoc % :type #'State)}})

(check {:type #'InitialState
        :balance 0.00M
        :beverageCount 0
        :snackCount 0})

(refine-to {:type #'InitialState
            :balance 0.00M
            :beverageCount 0
            :snackCount 0}
           #'State)