deferred_fn_output_schema_validation.clj

(ns deferred-fn-output-schema-validation
  (:require
   [manifold.deferred :as d]
   [schema.core :as s]
   [schema.spec.core :as s.spec]
   [schema.spec.leaf :as s.leaf]
   [schema.macros :as s.macros]
   [schema.utils :as s.utils]))

(defrecord Deferred [schema]
  s/Schema
  (spec [this]
    (s.leaf/leaf-spec
     (s.spec/simple-precondition this manifold.deferred/deferred?)))
  (explain [this]
    (list 'deferred (s/explain schema))))

(defn deferred [schema]
  (->Deferred schema))

(defn deferred-schema? [schema]
  (instance? Deferred schema))

(defn default-fn-validator
  [direction
   fn-name
   schema
   checker
   value]
  (when-let [error (checker value)]
    (s.m/error!
     (s.u/format*
      (str
       (case direction
         :input "Input to"
         :output "Output of")
       " %s does not match schema: \n\n\t \033[0;33m  %s \033[0m \n\n")
      fn-name (pr-str error))
     {:schema schema
      :value value
      :error error})))

(defn deferred-output-fn-validator
  [direction
   fn-name
   schema
   checker
   value]
  (let [value-schema (if (deferred-schema? schema)
                       (:schema schema)
                       schema)
        realized-value-validator (partial
                                  default-fn-validator
                                  direction
                                  fn-name
                                  value-schema
                                  checker)]
    (if (and (= :output direction)
             (d/deferred? value))
      (do
        (default-fn-validator
         direction
         fn-name
         schema
         checker
         value)
        (d/on-realized
         value
         realized-value-validator
         identity))
     (realized-value-validator value))))

(s/defn fallible-test-fn
  :- s/Int
  [x]
  (if (int? x)
    (* x x)
    x))

(s/defn fallible-non-deferred-test-fn
  :- (deferred s/Int)
  [x]
  (if (int? x)
    (* x x)
    x))

(s/defn deferred-fallible-test-fn
  :- (deferred s/Int)
  [x]
  (d/future
    (fallible-test-fn x)))

(comment
  (alter-var-root
   #'schema.core/fn-validator
   (constantly deferred-output-fn-validator))

  (fallible-test-fn 2)                ;; => 4
  (fallible-test-fn "2")              ;; => error! "not integer"

  (fallible-non-deferred-test-fn 2)   ;; => error! "not deferred"
  (fallible-non-deferred-test-fn "2") ;; => error! "not deferred

  (deferred-fallible-test-fn 2)       ;; => << 4 >>
  (deferred-fallible-test-fn "2")     ;; => << … >>

  @(deferred-fallible-test-fn 2)      ;; => 4
  @(deferred-fallible-test-fn "2")    ;; => error! "not integer"
  )

A couple natural expansions of this:

1. Add a schema wrapper s/Deferred to indicate a deferred is expected. ✅
2. Extend to also cover validation of manifold stream outputs, e.g. s/Stream <record schema> which would add a (stream/map) operation onto a returned stream validating each value against <record schema>.
3. Combine 1&2 in s/DeferredStream.