deps.edn

{:paths ["."]
 :deps  {com.cognitect/anomalies {:mvn/version "0.1.12"}
         io.xapix/axel-f         {:mvn/version "1.0.6"}}}

spec-test-repro.clj

(ns dev.spec-test-repro
  (:require
    [clojure.string :as str]
    [clojure.spec.alpha :as s]
    [clojure.spec.gen.alpha :as gen]
    [clojure.spec.test.alpha :as st]
    [cognitect.anomalies :as anomalies]
    [axel-f.core :as axel-f]))

(def generator? #'gen/generator?)

(defmacro gen-let
  "Macro for building generators using values from other generators.
  Uses a binding vector with the same syntax as clojure.core/let,
  where the right-hand side of the binding pairs are generators, and
  the left-hand side are names (or destructuring forms) for generated
  values.

  Subsequent generator expressions can refer to the previously bound
  values, in the same way as clojure.core/let.

  The body of the let can be either a value or a generator, and does
  the expected thing in either case. In this way let provides the
  functionality of both `bind` and `fmap`.

  Examples:

    (gen/let [strs (gen/not-empty (gen/list gen/string))
              s (gen/elements strs)]
      {:some-strings strs
       :one-of-those-strings s})

    ;; generates collections of \"users\" that have integer IDs
    ;; from 0...N-1, but are in a random order
    (gen/let [users (gen/list (gen/hash-map :name gen/string-ascii
                                            :age gen/nat))]
      (->> users
           (map #(assoc %2 :id %1) (range))
           (gen/shuffle)))"
  {:added "0.9.0"}
  [bindings & body]
  (assert (vector? bindings)
          "First arg to gen/let must be a vector of bindings.")
  (assert (even? (count bindings))
          "gen/let requires an even number of forms in binding vector")
  (if (empty? bindings)
    `(let [val# (do ~@body)]
       (if (generator? val#)
         val#
         (gen/return val#)))
    (let [[binding gen & more] bindings]
      `(gen/bind ~gen (fn [~binding] (gen-let [~@more] ~@body))))))

(s/def ::formula-var-name
  (s/with-gen (s/and string?
                     #(not (str/blank? %))
                     ;; only alphanumerics and -, _.
                     #(re-matches #"^[a-zA-Z]+[a-zA-Z0-9-_]*$" %))
    #(gen-let
       [suffix (gen/string-alphanumeric)
        prefix (gen/char-alpha)]
       (str prefix suffix))))

(s/def ::formula-string
  (s/with-gen (s/and string?
                     #(not (str/blank? %))
                     ;; only alphanumerics and -, _.
                     #(re-matches #"^[a-zA-Z]+[a-zA-Z0-9-_]*$" %))
    #(gen-let
       [suffix (gen/string-alphanumeric)
        prefix (gen/char-alpha)]
       (str prefix suffix))))

(defn num?
  "Returns true if `x` is a number and not NaN."
  [x]
  (and (number? x) (== x x)))

(s/def ::num
  (s/spec num?
          :gen #(gen/one-of [(gen/double* {:NaN? false}) (gen/large-integer)])))

(s/def ::formula-var-value ::num)
(s/def ::formula-vars-map
  (s/map-of ::formula-var-name
            (s/or :value ::formula-var-value
                  :nested-var-map ::formula-vars-map)
            :gen-max 4))

(s/def ::formula-function
  (s/fspec
    :args (s/cat :var-map ::formula-vars-map)
    :ret (s/nilable (s/or :num ::num :anomaly ::anomalies/anomaly))))

(defn formula->fn
  "Returns a function that takes a map of model metrics and returns a payoff or
   an anomaly. The model metric values will be bound according to [[bounds-metrics-map]]."
  [{:keys [formula-string]}]
  (let [formula-fn (try
                     (axel-f/compile formula-string)
                     (catch Exception ex
                       {::anomalies/category ::anomalies/incorrect
                        ::anomalies/message  (str "Failed to compile formula string. "
                                                  (str (.getMessage ex)))
                        :formula-string      formula-string}))]
    (if (::anomalies/category formula-fn)
      formula-fn
      (fn formula->fn'
        [var-map]
        (if (s/valid? ::formula-vars-map var-map)
          (try
            (formula-fn var-map)
            (catch Exception ex
              {::anomalies/category ::anomalies/fault
               ::anomalies/message  "Formula function threw an exception while running."
               :ex                  ex
               :metrics             var-map
               :formula-string      formula-string}))
          {::anomalies/category ::anomalies/incorrect
           ::anomalies/message  "Call to formula->fn must be a ::formula-vars-map"
           :explain             (s/explain-data ::formula-vars-map var-map)})))))

(s/fdef formula->fn
  :args (s/cat :arg-map (s/keys :req-un [::formula-string]))
  :ret (s/or :metric-fn ::formula-function
             :anom ::anomalies/anomaly))

(comment
  (st/check `formula->fn)
  )