WIP: Fix conditional compilation

.github/workflows/build.yml

@@ -13,17 +13,17 @@ on:
 
 jobs:
   setup:
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-22.04
     timeout-minutes: 10
     outputs:
       matrix: ${{ steps.set-matrix.outputs.matrix }}
     steps:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install clojure tools
-        uses: DeLaGuardo/setup-clojure@3.7
+        uses: DeLaGuardo/setup-clojure@main
         with:
-          lein: 2.9.8
+          lein: 2.11.2
       - name: Cache project dependencies
         uses: actions/cache@v4
         with:
@@ -48,19 +48,19 @@ jobs:
               ;;
           esac
   lint:
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-22.04
     timeout-minutes: 10
     steps:
       - uses: actions/checkout@v4
 
       - name: Install Java
-        uses: actions/setup-java@v3
+        uses: actions/setup-java@v4
         with:
           distribution: 'temurin'
           java-version: '8'
 
       - name: Install clojure tools
-        uses: DeLaGuardo/setup-clojure@12.1
+        uses: DeLaGuardo/setup-clojure@main
         with:
           clj-kondo: '2023.12.15'
 
@@ -71,13 +71,13 @@ jobs:
     needs: setup
     strategy:
       matrix: ${{fromJson(needs.setup.outputs.matrix)}}
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-22.04
     timeout-minutes: 10
     steps:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Cache project dependencies
-        uses: actions/cache@v3
+        uses: actions/cache@v4
         with:
           path: |
             ~/.m2/repository
@@ -86,21 +86,21 @@ jobs:
           restore-keys: |
             ${{ runner.os }}-clojure
       - name: Prepare java
-        uses: actions/setup-java@v2
+        uses: actions/setup-java@v4
         with:
           distribution: 'temurin'
           java-version: ${{ matrix.jdk }}
       - name: Install clojure tools
-        uses: DeLaGuardo/setup-clojure@3.7
+        uses: DeLaGuardo/setup-clojure@main
         with:
-          lein: 2.9.8
+          lein: 2.11.2
       - run: |
           set -x
           eval 'lein do clean, compile :all, ${CMD}'
         env:
           CMD: ${{ matrix.cmd }}
   all-pr-checks:
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-22.04
     timeout-minutes: 10
     needs: [test, lint]
     steps:

CHANGES.md

@@ -1,5 +1,7 @@
 # NEXT
 
+- fix `f/conditional` schemas that accept `nil` or `false`
+
 # 1.1.0 - 23rd January 2025
 
 - add OCSF schema support

project.clj

@@ -29,4 +29,5 @@
                              [clj-http "3.13.0"]
                              [potemkin "0.4.7"]
                              [metosin/malli "0.17.0"]
+                             [prismatic/schema-generators "0.1.5" :exclusions [prismatic/schema]]
                              [io.github.threatgrid/ocsf-schema-export "1.0.0-SNAPSHOT"]]}})

src/flanders/core.cljc

@@ -90,8 +90,7 @@
           (if (nil? p+t) [types tests]
               (recur more
                      (conj types t)
-                     (conj tests (let [p (if (= :else p) (constantly true) p)]
-                                   #(when (p %) %))))))]
+                     (conj tests (if (= :else p) any? p)))))]
     (ft/map->EitherType {:choices types
                          :tests tests})))
 

src/flanders/malli.clj

@@ -42,14 +42,41 @@
   ;; Branches
 
   EitherType
-  (->malli' [{:keys [choices key?]} opts]
-    ;;TODO `choices` allows dispatch like :multi, but they're in the wrong format
+  (->malli' [{:keys [tests choices key?]} opts]
+    ;; e.g., (f/conditional #(= false %) f/any-bool) will choose true as an example
     (let [f #(->malli' % opts)
-          choice-schemas (map f choices)
-          s (m/schema (into [:or] choice-schemas))]
-      (if key?
-        {:op :default-key :schema s}
-        s)))
+          ;; note: if test is more narrow than the choice, the example will be wrong.
+          choice-schemas (mapv f choices)]
+      (if-some [tests (some-> (not-empty tests) vec)]
+        (let [ntests (count tests)
+              _ (run! (fn [i]
+                        (let [guard (nth tests i)
+                              schema (nth choice-schemas i)]
+                          (when-not (-> schema (m/properties opts) :json-schema/example guard)
+                            (println (format "[flanders.malli] WARNING: generated example for %s does not satisfy guard: %s"
+                                             (m/form schema)
+                                             (str guard))))))
+                      (range ntests))]
+          (into [:multi {:dispatch (fn [v]
+                                     (or (some #(when ((nth tests %) v) %) (range ntests))
+                                         :dispatch-failed))}]
+                (map-indexed (fn [i s]
+                               [i (m/-update-properties s assoc :gen/schema
+                                                        ;; :multi assumes schemas for generators passes preds, must assert
+                                                        ;; explicitly. :and + :fn could fail, but throws an error pointing
+                                                        ;; to this schema, so putting a property to help debugging.
+                                                        ;; if you find yourself here, trying looking for `conditional` schemas
+                                                        ;; in CTIM where the predicate does not match the same values as the schema.
+                                                        ;; e.g., (f/conditional #(= false %) f/any-bool)
+                                                        ;; should be (f/conditional #(= false %) (f/enum false))
+                                                        (m/form [:and {::if-this-fails-see :flanders.malli/->malli}
+                                                                 s
+                                                                 [:fn (nth tests i)]]))]))
+                choice-schemas))
+        (let [s (m/schema (into [:or] choice-schemas))]
+          (if key?
+            {:op :default-key :schema s}
+            s)))))
 
   MapEntry
   (->malli' [{:keys [key type required? key?] :as entry} opts]

src/flanders/spec.clj

@@ -63,13 +63,16 @@
   ;; Branches
 
   EitherType
-  (->spec' [{:keys [choices]} ns f]
+  (->spec' [{:keys [tests choices]} ns f]
     (let [choices (->> choices
                        (map-indexed
                         (fn [i c]
                           (let [label (str "choice" i)
                                 spec (f c (str ns "." label))]
-                            (eval `(s/def ~(keyword ns label) ~spec))
+                            (eval `(s/def ~(keyword ns label) ~(if-some [t (nth tests i nil)]
+                                                                 ;;hmm this doesn't s/exercise 
+                                                                 `(s/and ~spec ~t)
+                                                                 spec)))
                             (assoc c
                                    :label (keyword label)
                                    :spec spec)))))

test/flanders/malli_test.clj

@@ -1,12 +1,14 @@
 (ns flanders.malli-test
-  (:require [clojure.test :refer [deftest is testing]]
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
             [clojure.walk :as w]
             [flanders.examples
              :refer [Example
                      OptionalKeywordMapEntryExample]]
             [flanders.core :as f]
             [flanders.malli :as fm]
             [malli.core :as m]
+            [malli.generator :as mg]
             [malli.swagger :as ms]
             [malli.util :as mu]))
 
@@ -98,6 +100,24 @@
            (->malli-frm (f/either :choices [(f/bool) (f/str)]))))
     (is (= [:map {:closed true} [:malli.core/default [:map-of [:or :boolean :string] :any]]]
            (->malli-frm (f/map [(f/entry (f/either :choices [(f/bool) (f/str)]) f/any)])))))
+  (testing "conditional"
+    (is (= [:multi {:dispatch true}
+            [0 [:boolean #:gen{:schema
+                               [:and #:flanders.malli{:if-this-fails-see :flanders.malli/->malli}
+                                ;; FIXME nil due to form-no-swagger in this namespace
+                                [:boolean nil]
+                                [:fn boolean?]]}]]]
+           (-> (->malli-frm (f/conditional boolean? f/any-bool))
+               (update-in [1 :dispatch] fn?))))
+    (is (= [:multi {:dispatch true}
+            [0 [:boolean #:gen{:schema [:and #:flanders.malli{:if-this-fails-see :flanders.malli/->malli}
+                                        [:boolean nil] ;; FIXME nil due to form-no-swagger in this namespace
+                                        [:fn boolean?]]}]]
+            [1 [:string #:gen{:schema [:and #:flanders.malli{:if-this-fails-see :flanders.malli/->malli}
+                                       [:string nil]
+                                       [:fn string?]]}]]]
+           (-> (->malli-frm (f/conditional boolean? f/any-bool string? f/any-str))
+               (update-in [1 :dispatch] fn?)))))
   (testing "sig"
     (is (= [:=> [:cat :int] :int]
            (->malli-frm (f/sig :parameters [(f/int)] :return (f/int)))))
@@ -225,3 +245,45 @@
          (-> Example
              fm/->malli
              ms/transform))))
+
+(deftest conditional-test
+  (testing "predicates that return true for false work"
+    (is (m/validate
+          (fm/->malli (f/conditional
+                        boolean? f/any-bool))
+          false))
+    (is (m/validate
+          (fm/->malli (f/conditional
+                        false? (f/bool :equals false)))
+          false)))
+  (testing "predicates that return true for nil work"
+    (with-out-str ;; suppress expected warning on conditions
+      (is (m/validate
+            (fm/->malli (f/conditional
+                          nil? f/any))
+            nil))))
+  (testing "predicates that return false for false and nil work"
+    (with-out-str ;; suppress expected warning on conditions
+      (is (not (m/validate
+                 (fm/->malli (f/conditional
+                               (constantly false) f/any))
+                 false)))
+      (is (not (m/validate
+                 (fm/->malli (f/conditional
+                               (constantly false) f/any))
+                 nil)))))
+  (testing "warning if predicate and schema disagree"
+    (is (str/starts-with?
+          (binding [*print-length* nil
+                    *print-level* nil
+                    *print-namespace-maps* false]
+            (with-out-str
+              (fm/->malli (f/conditional
+                            false? f/any-bool))))
+          "[flanders.malli] WARNING: generated example for [:boolean {:json-schema/example true}] does not satisfy guard: clojure.core$false_QMARK")))
+  (testing "condition predicates are taken into account in generators"
+    (is (thrown-with-msg? Exception
+                          #":malli\.generator/and-generator-failure"
+                          (with-out-str ;; suppress expected generated example warning
+                                        (mg/generate (fm/->malli (f/conditional
+                                                                   (constantly false) f/any-bool))))))))

test/flanders/schema_test.clj

@@ -5,7 +5,8 @@
    [flanders.examples :refer [Example OptionalKeywordMapEntryExample]]
    [flanders.schema :as fs]
    [ring.swagger.json-schema :as js]
-   [schema.core :as s]))
+   [schema.core :as s]
+   [schema-generators.generators :as sg]))
 
 (deftest test-valid-schema
   (is
@@ -160,3 +161,38 @@
   (is (= {:example "string" :description "Str"} (->swagger (assoc f/any-str :description "Str"))))
   (is (= {:example "a" :description "Str"} (->swagger (f/enum #{"b" "c" "a"} :description "Str"))))
   (is (= {:example "default" :description "Str"} (->swagger (assoc f/any-str :description "Str" :default "default")))))
+
+(deftest conditional-test
+  (testing "predicates that return true for false work"
+    (is (nil? (s/check
+                (fs/->schema (f/conditional
+                               :else f/any-bool))
+                false)))
+    (is (nil? (s/check
+                (fs/->schema (f/conditional
+                               false? (f/bool :equals false)))
+                false))))
+  (testing "predicates that return true for nil work"
+    (is (nil? (s/check
+                (fs/->schema (f/conditional
+                               :else f/any))
+                nil)))
+    (is (nil? (s/check
+                (fs/->schema (f/conditional
+                               nil? f/any))
+                nil))))
+  (testing "predicates that return false for false and nil work"
+    (is (s/check
+          (fs/->schema (f/conditional
+                         (constantly false) f/any))
+          false))
+    (is (s/check
+          (fs/->schema (f/conditional
+                         (constantly false) f/any))
+          nil)))
+  (testing "condition predicates are taken into account in generators"
+    (is (thrown-with-msg? Exception
+                          #"Couldn't satisfy such-that predicate"
+                          (sg/generate
+                            (fs/->schema (f/conditional
+                                           (constantly false) f/any-bool)))))))

test/flanders/spec_test.clj

@@ -12,8 +12,8 @@
 (use-fixtures :once
   (fn [t]
     (stest/instrument 'fs/->spec)
-    (t)
-    (stest/unstrument 'fs/->spec)))
+    (try (t)
+         (finally (stest/unstrument 'fs/->spec)))))
 
 (deftest test-valid-spec
   (is
@@ -139,3 +139,42 @@
          (s/form (fs/->spec (f/bool :equals true) "bool"))))
   (is (= #{false}
          (s/form (fs/->spec (f/bool :equals false) "bool")))))
+
+(deftest conditional-test
+  (testing "predicates that return true for false work"
+    (is (s/valid?
+          (fs/->spec (f/conditional
+                        boolean? f/any-bool)
+                     (str `conditional-test))
+          false))
+    (is (s/valid?
+          (fs/->spec (f/conditional
+                        false? (f/bool :equals false))
+                     "conditional-test")
+          false)))
+  (testing "predicates that return true for nil work"
+    (is (s/valid?
+          (fs/->spec (f/conditional
+                       nil? f/any)
+                     "conditional-test")
+          nil)))
+  (testing "predicates that return false for false and nil work"
+    (is (not (s/valid?
+               (fs/->spec (f/conditional
+                            (constantly false) f/any)
+                          "conditional-test")
+               false)))
+    (is (not (s/valid?
+               (fs/->spec (f/conditional
+                            (constantly false) f/any)
+                          "conditional-test")
+               nil))))
+  (testing "condition predicates are taken into account in generators"
+    (is (s/exercise (fs/->spec (f/conditional
+                                 :else f/any-bool)
+                               "conditional-test")))
+    (is (thrown-with-msg? Exception
+                          #":spec\.generator/and-generator-failure"
+                          (s/exercise (fs/->spec (f/conditional
+                                                   (constantly false) f/any-bool)
+                                                 "conditional-test"))))))