├── CODEOWNERS ├── deps.edn ├── .gitignore ├── project.clj ├── .circleci └── config.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── test └── schema_refined │ └── core_test.clj └── src └── schema_refined └── core.clj /CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @gsnewmark @serzh 2 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {prismatic/schema {:mvn/version "1.1.9"}}} 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | *~ 11 | .idea 12 | *.iml 13 | .cpcache/ 14 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.attendify/schema-refined "0.3.0-alpha6" 2 | :description "Clojure library to keep you away from bugs with precise schemas (refined types with runtime checks)" 3 | :Url "https://github.com/KitApps/schema-refined" 4 | :license {:name "The MIT License" 5 | :url "http://opensource.org/licenses/MIT"} 6 | 7 | :dependencies [[prismatic/schema "1.1.9"]] 8 | 9 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.7.0"]]} 10 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} 11 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 12 | :1.10 {:dependencies [[org.clojure/clojure "1.10.0"]]}} 13 | 14 | :deploy-repositories {"clojars" {:sign-releases false}}) 15 | -------------------------------------------------------------------------------- /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | 3 | shared: &shared 4 | environment: 5 | LEIN_ROOT: "true" 6 | steps: 7 | - checkout 8 | - restore_cache: 9 | key: << checksum "project.clj" >> 10 | - run: lein with-profiles dev:dev,1.8:dev,1.9:dev,1.10 deps 11 | - save_cache: 12 | paths: 13 | - ~/.m2 14 | key: << checksum "project.clj" >> 15 | - run: lein do clean, with-profiles dev:dev,1.8:dev,1.9:dev,1.10 test 16 | 17 | jobs: 18 | jdk-8: 19 | docker: 20 | - image: circleci/clojure:openjdk-8-lein-2.9.0 21 | <<: *shared 22 | 23 | jdk-11: 24 | docker: 25 | - image: circleci/clojure:openjdk-11-lein-2.9.0 26 | <<: *shared 27 | 28 | workflows: 29 | version: 2 30 | build: 31 | jobs: 32 | - "jdk-8" 33 | - "jdk-11" 34 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## [not released] 0.3.0-alpha6 4 | 5 | ## 0.3.0-alpha5 6 | 7 | * Added new numeric type `EpsilonOf` 8 | 9 | * Fixed `Distinct`, `DistinctBy` predicates, `DistinctListOf`, 10 | `NonEmptyDistinctListOf` types: all of them didn't actually check 11 | distinctiveness in previous release due to incorrect apply of `distinct?` 12 | function to the list of arguments 13 | 14 | * Fixed `Exists` predicate: it failed with runtime exception on every check in 15 | previous release due to the typo 16 | 17 | * Removed Potemkin dependency 18 | 19 | * Introduced `refined'` macro to deal with namings of types (captures the type name 20 | as it was specified in the code *before* resolving the var itself) 21 | 22 | * Added `deps.edn` 23 | 24 | * `And` and `Or` predicates to support variadic arguments 25 | 26 | ## 0.3.0-alpha4 27 | 28 | * Well... I've started here :) 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2018 KitApps Inc. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## schema-refined 2 | 3 | [![CircleCI](https://circleci.com/gh/KitApps/schema-refined.svg?style=svg)](https://circleci.com/gh/KitApps/schema-refined) 4 | 5 | Powerful "refined" steroids for [schema](https://github.com/plumatic/schema) library. 6 | 7 | Type refinement is all about making the types (schemas) more precise to keep you away from errors and bugs. All heavy lifting of checking/validation the shape of the data is done by `schema` library. Here we introduce a few new concepts to make schemas flexible and more expressive: 8 | 9 | * `types` are basically schemas (see `Schema` protocol). All operations with types return types, but we're trying to deal with them as data not just functions. We gain a lot from such approach (`schema` would force you treat your type checks as black boxes) 10 | 11 | * `predicates`, like `(LessThan 10)` or `NonEmpty`, that you can combine using logical operations `and`, `or`, `not` etc (or define your own) 12 | 13 | * product types with `Struct` that you can accrete and reduce "on fly" (think, as maps on steroids) 14 | 15 | * sum types with explicit dispatching that you can use not loosing flexibility (think, as `schema.core/conditional` on steroids) 16 | 17 | * `refined` to glue all the above together (think, as `schema.core/constrained` on steroids) 18 | 19 | And more! 20 | 21 | Add to your project with Leiningen/Boot: 22 | 23 | ```clojure 24 | [com.attendify/schema-refined "0.3.0-alpha4"] 25 | ``` 26 | 27 | or with deps.edn 28 | 29 | ```clojure 30 | com.attendify/schema-refined {:mvn/version "0.3.0-alpha4"} 31 | ``` 32 | 33 | ## Our Goals 34 | 35 | * **Readability** and **Soundness** 36 | 37 | * Being **as precise as we can** 38 | 39 | * Avoid **as many bugs** as possible 40 | 41 | * Provide clean and **useful** error messages 42 | 43 | ## Talks and Tutorials 44 | 45 | * [Keep Your Data Safe with Refined Types](https://speakerdeck.com/kachayev/keep-your-data-safe-with-refined-types) 46 | 47 | ## Inspired By 48 | 49 | * [Refined in Haskell](https://github.com/nikita-volkov/refined) 50 | * [Refined in Scala](https://github.com/fthomas/refined) 51 | 52 | ## Usage 53 | 54 | Get ready! 55 | 56 | ```clojure 57 | (require '[schema-refined.core :as r]) 58 | (require '[schema.core :as s]) 59 | ``` 60 | 61 | ### Refined 62 | 63 | `schema-refined.core/refined` is a supercharged version of `schema.core/constrained`. This function takes 64 | two params: a **type** (which should be a valid schema) and a **predicate** (which should either satisfy 65 | `schema-refiend.core/Predicate` protocol or be a function from value of given **type** to boolean) and 66 | returns a schema that checks both that "basic" schema (given as a **type**) is satisfied and the predicates 67 | returns `true` for this specific value. You can also use another schema as a predicate. There are a lot of 68 | built-in **predicates**, please check the listing below. **Predicates** are composable, you can create 69 | a new one from existing using logical rules `And`, `Or`, `Not` and `On` (checks predicate after applying to 70 | the value given function). There're also a few high-level predicaetes to deal with collections, like `Forall`, 71 | `First`, `Last` etc. 72 | 73 | Motivational example. 74 | 75 | ```clojure 76 | ;; "manually" with refined and predicates 77 | (def LatCoord (r/refined double (r/OpenClosedInterval -90.0 90.0))) 78 | 79 | ;; the same using built-in types 80 | ;; (or functions to create types from other types, a.k.a. generics) 81 | (def LngCoord (r/OpenClosedIntervalOf double -180.0 180.0)) 82 | 83 | ;; Product type using a simple map 84 | (def GeoPoint {:lat LatCoord :lng LngCoord}) 85 | 86 | ;; using built-in types 87 | (def Route (r/BoundedListOf GeoPoint 2 50)) 88 | 89 | ;; or same with predicates 90 | (def Route (r/refined [GeoPoint] (BoundedSize 2 50))) 91 | 92 | (def input [{:lat 48.8529 :lng 2.3499} 93 | {:lat 51.5085 :lng -0.0762} 94 | {:lat 40.0086 :lng 28.9802}]) 95 | 96 | ;; Route now is a valid schema, so you can use it as any other schema 97 | (s/check Route input) 98 | ``` 99 | 100 | Even more motivational example. 101 | 102 | ```clojure 103 | (def InZurich {:lat (r/refined double (r/OpenInterval 47.34 47.39)) 104 | :lng (r/refined double (r/OpenInterval 8.51 8.57))}) 105 | 106 | (def InRome {:lat (r/refined double (r/OpenInterval 41.87 41.93)) 107 | :lng (r/refined double (r/OpenInterval 12.46 12.51))}) 108 | 109 | ;; you can use schemas as predicates 110 | (def RouteFromZurich (r/refined Route (r/First InZurich))) 111 | (def RouteToRome (r/refined Route (r/Last InRome))) 112 | (def RouteFromZurichToRome (r/refined Route (r/And (r/First InZurich) (r/Last InRome)))) 113 | 114 | ;; or even more 115 | ;; note, that predicates are composable 116 | (def FromZurichToRome (r/And (r/First InZurich) (r/Last InRome))) 117 | (def RouteFromZurichToRomeWithLess3Hops 118 | (r/refined Route (r/And FromZurichToRome (r/BoundedSize 2 5)))) 119 | ``` 120 | 121 | ### Naming Convention 122 | 123 | The library follows a few rules on how names are made, so it's easier to make sense of types and predicates: 124 | 125 | * function that takes **type** (schema) to create refined version has `Of` suffix. E.g. `NonEmptyListOf` 126 | 127 | * specific refined **type** has suffix of a basic **type**, predicates are suffix-free. E.g. `LowerCased` is 128 | a **predicate**, `LowerCasedStr` is a **type** 129 | 130 | ### Sum Types 131 | 132 | Schema previously had `s/either` to deal with sum types. Which didn't work the way e.g. `one-of` doesn't work 133 | when dealing with JSON schema: the description is fragile and error messages is not useful at all ("typing" message 134 | that given data does not conform any of the listed options would only confuse). That's why `schema` switch to 135 | `conditional` where you have to specify branching predicate in advance. `schema-refined` includes slightly more 136 | readable version of conditionals `r/dispatch-on` that covers the fundamental use case of having a single predicate 137 | to decide on the branch (option). 138 | 139 | ```clojure 140 | (def EmptyScrollableList 141 | {:items (s/eq []) 142 | :totalCount (s/eq 0) 143 | :hasNext (s/eq false) 144 | :hasPrev (s/eq false) 145 | :nextPageCursor (s/eq nil) 146 | :prevPageCursor (s/eq nil)}) 147 | 148 | (defn NonEmptyScrollableListOf [dt] 149 | (r/dispatch-on (juxt :hasNext :hasPrev) 150 | [false false] (SinglePageOf dt) 151 | [true false] (FirstPageOf dt) 152 | [false true] (LastPageOf dt) 153 | [true true] (ScrollableListSliceOf dt))) 154 | 155 | (defn ScrollableListOf [dt] 156 | (r/dispatch-on :totalCount 157 | 0 EmptyScrollableList 158 | :else (NonEmptyScrollableListOf dt))) 159 | ``` 160 | 161 | ### Product Types 162 | 163 | `schema-refined.core/Struct` creates a **product type** which works like a simple map, but can be flexible 164 | refined with `schema-refined.core/guard`. Guarded struct still can be changed "on fly" using `assoc` (think: 165 | adding a new **field** to the **record**) and `dissoc` (think: removing specific **field** from the **record**). 166 | 167 | ```clojure 168 | (def -FreeTicket (r/Struct 169 | :id r/NonEmptyStr 170 | :type (s/eq "free") 171 | :title r/NonEmptyStr 172 | :quantity (r/OpenIntervalOf int 1 1e4) 173 | :description (s/maybe r/NonEmptyStr) 174 | :status (s/enum :open :closed))) 175 | 176 | (def FreeTicket (r/guard -FreeTicket '(:quantity :status) enough-sits-when-open)) 177 | 178 | ;; # 186 | ``` 187 | 188 | You can easily extend the **type** now: 189 | 190 | ```clojure 191 | (def -PaidTicket (assoc FreeTicket 192 | :type (s/eq "paid") 193 | :priceInCents r/PositiveInt 194 | :taxes [Tax] 195 | :fees (s/enum :absorb :pass))) 196 | 197 | (def PaidTicket 198 | (r/guard -PaidTicket '(:taxes :fees) pass-tax-included)) 199 | 200 | ;; # 204 | ``` 205 | 206 | and reduce: 207 | 208 | ```clojure 209 | (dissoc PaidTicket :status) 210 | 211 | ;; # 214 | 215 | ;; (only one guard left) 216 | ``` 217 | 218 | `schema-refined.core/StructDispatch` provides you the same functionality as `schema-refined.core/dispatch-on`, 219 | but the resulting **type** behaves like a one created with `schema-refined.core/Struct`. 220 | 221 | ```clojure 222 | (def Ticket (r/StructDispatch :type 223 | "free" FreeTicket 224 | "paid" PaidTicket)) 225 | 226 | ;; # {...} 228 | ;; paid => {...}> 229 | 230 | ;; note, that when using `schema.core/conditional` the following would not 231 | ;; give you intended result! but it works as expected here 232 | (def CreateTicketRequest (dissoc Ticket :id :status)) 233 | ``` 234 | 235 | ### More? 236 | 237 | To find more examples and use cases, please see doc strings (whenever applicable) and tests. 238 | 239 | ## Future Versions (a.k.a In Progress) 240 | 241 | * Separate "serialization" presentation (basic Scalar types) fro "business" logic and rules with 242 | a flexibility to send pointers to all predicates over the wire 243 | 244 | * Maybe we need another way to deal with generics to provide flexibility with higher kinded types 245 | (using function to build a new type hides some information about the underlying representation and 246 | it's impossible to extend w/o reimplemention) 247 | 248 | * Try to catch "impossible" predicates (which defines empty sets of values), like `(And (Less 10) (Greater 100))` 249 | 250 | * Clean and concise way to represent transformation invariants (right now you can only define your output 251 | type as a function from input value, doing manual manipulations, which might be kinda tricky and not very 252 | obvious for the reader of your code) 253 | 254 | * Support generative testing (probably bridge to the existing tools) 255 | 256 | ## Appendix A: Builtin Predicates & Types 257 | 258 | ### Predicate Combinators 259 | 260 | * `Not` 261 | * `And` 262 | * `Or` 263 | * `On` 264 | 265 | ### Ordering Predicates 266 | 267 | * `Equal` 268 | * `Less` 269 | * `LessOrEqual` 270 | * `Greater` 271 | * `GreaterOrEqual` 272 | * `Ascending` 273 | * `AscendingBy` 274 | * `AscendingOn` 275 | * `Descending` 276 | * `DescendingBy` 277 | * `DescendingOn` 278 | 279 | ### Numerical Predicates 280 | 281 | * `Even` 282 | * `Odd` 283 | * `Modulo` 284 | * `DivisibleBy` 285 | * `NonDivisibleBy` 286 | * `OpenInterval` 287 | * `ClosedInterval` 288 | * `OpenClosedInterval` 289 | * `ClosedOpenInterval` 290 | * `Epsilon` 291 | 292 | ### Numerical Types 293 | 294 | * `PositiveOf` 295 | * `NegativeOf` 296 | * `NonNegativeOf` 297 | * `NonPositiveOf` 298 | * `PositiveInt` 299 | * `NegativeInt` 300 | * `NonNegativeInt` 301 | * `NonPositiveInt` 302 | * `PositiveDouble` 303 | * `NegativeDouble` 304 | * `NonNegativeDouble` 305 | * `NonPositiveDouble` 306 | * `OpenIntervalOf` 307 | * `ClosedIntervalOf` 308 | * `OpenClosedIntervalOf` 309 | * `ClosedOpenIntervalOf` 310 | * `EpsilonOf` 311 | 312 | ### String Predicates 313 | 314 | * `Uri` 315 | * `Url` 316 | * `StartsWith` 317 | * `EndsWith` 318 | * `Includes` 319 | * `LowerCased` 320 | * `UpperCased` 321 | 322 | ### String Types 323 | 324 | * `NonEmptyStr` 325 | * `BoundedSizeStr` 326 | * `DigitChar` 327 | * `ASCIILetterChar` 328 | * `ASCIILetterOrDigitChar` 329 | * `BitChar` 330 | * `BitStr` 331 | * `IntStr` 332 | * `FloatStr` 333 | * `UriStr` 334 | * `UrlStr` 335 | * `StartsWithStr` 336 | * `EndsWithStr` 337 | * `IncludesStr` 338 | * `LowerCasedStr` 339 | * `UpperCasedStr` 340 | 341 | ### Collection Predicates 342 | 343 | * `Empty` 344 | * `NonEmpty` 345 | * `BoundedSize` 346 | * `Distinct` 347 | * `DistinctBy` 348 | * `Forall` 349 | * `Exists` 350 | * `First` 351 | * `Second` 352 | * `Index` 353 | * `Rest` 354 | * `Last` 355 | * `Butlast` 356 | * `Pairwise` 357 | 358 | ### Collection Types 359 | 360 | * `EmptyList` 361 | * `EmptySet` 362 | * `EmptyMap` 363 | * `NonEmptyListOf` 364 | * `NonEmptyMapOf` 365 | * `NonEmptySetOf` 366 | * `BoundedListOf` 367 | * `BoundedSetOf` 368 | * `BoundedMapOf` 369 | * `SingleValueListOf` 370 | * `SingleValueSetOf` 371 | * `SingleValueMapOf` 372 | * `DistinctListOf` 373 | * `NonEmptyDistinctListOf` 374 | 375 | ## Contribute 376 | 377 | * Check for open issues or open a fresh issue to start a discussion around a feature idea or a bug. 378 | * Fork the repository on Github & fork master to `feature-*` (or `ft-`) branch to start making your changes. 379 | * Write a test which shows that the bug was fixed or that the feature works as expected. 380 | 381 | or simply... 382 | 383 | * Use it. 384 | * Enjoy it. 385 | * Spread the word. 386 | 387 | ## License 388 | 389 | `schema-refined` is licensed under the MIT license, available at [MIT](http://opensource.org/licenses/MIT) and also in the LICENSE file. 390 | 391 | Implementation of `-def-map-type` is based on [Potemkin](https://github.com/ztellman/potemkin) (Copyright © 2013 Zachary Tellman) 392 | -------------------------------------------------------------------------------- /test/schema_refined/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns schema-refined.core-test 2 | (:require [schema-refined.core :as r] 3 | [clojure.test :as t] 4 | [schema.core :as s])) 5 | 6 | (defmacro ok! [dt value] 7 | `(t/is (nil? (s/check ~dt ~value)))) 8 | 9 | (defmacro not-ok! [dt value] 10 | `(t/is (some? (s/check ~dt ~value)))) 11 | 12 | (defn numeric-map [size] 13 | (->> size 14 | range 15 | (map-indexed vector) 16 | (into {}))) 17 | 18 | (t/testing "refined" 19 | (let [LatCoord (r/refined double (r/OpenClosedInterval -90.0 90.0)) 20 | LngCoord (r/OpenClosedIntervalOf double -180.0 180.0) 21 | GeoPoint {:lat LatCoord :lng LngCoord} 22 | Route (r/BoundedListOf GeoPoint 2 50) 23 | 24 | input [{:lat 47.3529 :lng 8.5199} 25 | {:lat 51.5085 :lng -0.0762} 26 | {:lat 41.8705 :lng 12.4750}]] 27 | 28 | (t/deftest refined-with-built-in-predicates 29 | (ok! Route input)) 30 | 31 | (t/deftest refined-with-built-in-pred-generics 32 | (let [InZurich {:lat (r/refined double (r/OpenInterval 47.34 47.39)) 33 | :lng (r/refined double (r/OpenInterval 8.51 8.57))} 34 | 35 | InRome {:lat (r/refined double (r/OpenInterval 41.87 41.93)) 36 | :lng (r/refined double (r/OpenInterval 12.46 12.51))} 37 | 38 | RouteFromZurich (r/refined Route (r/First InZurich)) 39 | RouteToRome (r/refined Route (r/Last InRome)) 40 | RouteFromZurichToRome (r/refined Route (r/And (r/First InZurich) (r/Last InRome))) 41 | 42 | FromZurichToRome (r/And (r/First InZurich) (r/Last InRome)) 43 | RouteFromZurichToRomeWithLess3Hops (r/refined Route (r/And FromZurichToRome (r/BoundedSize 2 5)))] 44 | (ok! RouteFromZurichToRome input) 45 | (ok! RouteFromZurichToRomeWithLess3Hops input))) 46 | 47 | (t/deftest refined-with-on-predicate 48 | (ok! (r/refined GeoPoint (r/On :lng r/NegativeDouble)) 49 | {:lat 51.5085 :lng -0.0762}) 50 | 51 | (not-ok! (r/refined GeoPoint (r/On :lat r/NegativeDouble)) 52 | {:lat 47.3529 :lng 8.5199}))) 53 | 54 | (t/deftest refined-with-boolean-predicates 55 | (ok! (r/refined s/Int (r/Not r/NegativeInt)) 42) 56 | (ok! (r/refined s/Int (r/And r/PositiveInt (r/Less 108))) 42) 57 | (ok! (r/refined s/Int (r/Or r/PositiveInt (r/Less -7))) -42) 58 | (ok! (r/refined s/Int (r/And (r/Less 10) (r/Less 20) (r/Less 30))) 5) 59 | (ok! (r/refined s/Int (r/Or (r/Less 10) (r/Greater 50) (r/Equal 20))) 5) 60 | (ok! (r/refined s/Int (r/Or (r/Less 10) (r/Greater 50) (r/Equal 20))) 20) 61 | (ok! (r/refined s/Int (r/Or (r/Less 10) (r/Greater 50) (r/Equal 20))) 55) 62 | 63 | (not-ok! (r/refined s/Int (r/Not r/NegativeInt)) -42) 64 | (not-ok! (r/refined s/Int (r/And r/PositiveInt (r/Less 108))) 142) 65 | (not-ok! (r/refined s/Int (r/Or r/PositiveInt (r/Less -7))) -3) 66 | (not-ok! (r/refined s/Int (r/And (r/Less 10) (r/Less 20) (r/Less 30))) 15) 67 | (not-ok! (r/refined s/Int (r/And (r/Less 10) (r/Less 20) (r/Less 30))) 25) 68 | (not-ok! (r/refined s/Int (r/Or (r/Less 10) (r/Greater 50) (r/Equal 20))) 25)) 69 | 70 | (t/deftest refined-with-equal-predicate 71 | (ok! (r/refined s/Int (r/Equal 42)) 42) 72 | (ok! (r/refined s/Str (r/Equal "doom")) "doom") 73 | 74 | (not-ok! (r/refined s/Int (r/Equal 42)) 43) 75 | (not-ok! (r/refined s/Str (r/Equal "doom")) "Doom")) 76 | 77 | (t/deftest refined-with-less-predicate 78 | (ok! (r/refined s/Int (r/Less 108)) 42) 79 | (ok! (r/refined double (r/Less 0.7)) 0.5) 80 | 81 | (not-ok! (r/refined s/Int (r/Less 108)) 108) 82 | (not-ok! (r/refined double (r/Less 0.7)) 3.14)) 83 | 84 | (t/deftest refined-with-less-or-equal-predicate 85 | (ok! (r/refined s/Int (r/LessOrEqual 108)) 42) 86 | (ok! (r/refined s/Int (r/LessOrEqual 108)) 108) 87 | (ok! (r/refined double (r/LessOrEqual 0.7)) 0.7) 88 | 89 | (not-ok! (r/refined s/Int (r/LessOrEqual 108)) 109) 90 | (not-ok! (r/refined double (r/LessOrEqual 0.7)) 3.14)) 91 | 92 | (t/deftest refined-with-greater-predicate 93 | (ok! (r/refined s/Int (r/Greater 42)) 108) 94 | (ok! (r/refined double (r/Greater 0.5)) 0.7) 95 | 96 | (not-ok! (r/refined s/Int (r/Greater 108)) 108) 97 | (not-ok! (r/refined double (r/Greater 3.14)) 0.7)) 98 | 99 | (t/deftest refined-with-greater-or-equal-predicate 100 | (ok! (r/refined s/Int (r/GreaterOrEqual 42)) 108) 101 | (ok! (r/refined s/Int (r/GreaterOrEqual 108)) 108) 102 | (ok! (r/refined double (r/GreaterOrEqual 0.7)) 0.7) 103 | 104 | (not-ok! (r/refined s/Int (r/GreaterOrEqual 109)) 108) 105 | (not-ok! (r/refined double (r/GreaterOrEqual 3.14)) 0.7)) 106 | 107 | (t/deftest refined-with-open-interval-predicate 108 | (ok! (r/refined s/Int (r/OpenInterval 0 43)) 42) 109 | (ok! (r/refined double (r/OpenInterval 0.0 1.0)) 0.7) 110 | (ok! (r/refined s/Int (r/Epsilon 10 5)) 10) 111 | (ok! (r/refined s/Int (r/Epsilon 10 5)) 13) 112 | (ok! (r/refined s/Int (r/Epsilon 10 5)) 7) 113 | 114 | (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 0) 115 | (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 43) 116 | (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) -7) 117 | (not-ok! (r/refined s/Int (r/OpenInterval 0 43)) 108) 118 | (not-ok! (r/refined double (r/OpenInterval 0.0 1.0)) 0.0) 119 | (not-ok! (r/refined double (r/OpenInterval 0.0 1.0)) 1.0) 120 | (not-ok! (r/refined double (r/OpenInterval 0.0 1.0)) 3.14) 121 | (not-ok! (r/refined double (r/OpenInterval 0.0 1.0)) -3.14) 122 | (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 5) 123 | (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 15) 124 | (not-ok! (r/refined s/Int (r/Epsilon 10 5)) -7) 125 | (not-ok! (r/refined s/Int (r/Epsilon 10 5)) 108)) 126 | 127 | (t/deftest refined-with-closed-interval-predicate 128 | (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 42) 129 | (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 0) 130 | (ok! (r/refined s/Int (r/ClosedInterval 0 43)) 43) 131 | (ok! (r/refined double (r/ClosedInterval 0.0 1.0)) 0.7) 132 | (ok! (r/refined double (r/ClosedInterval 0.0 1.0)) 0.0) 133 | (ok! (r/refined double (r/ClosedInterval 0.0 1.0)) 1.0) 134 | 135 | (not-ok! (r/refined s/Int (r/ClosedInterval 0 43)) -7) 136 | (not-ok! (r/refined s/Int (r/ClosedInterval 0 43)) 108) 137 | (not-ok! (r/refined double (r/ClosedInterval 0.0 1.0)) 3.14) 138 | (not-ok! (r/refined double (r/ClosedInterval 0.0 1.0)) -3.14)) 139 | 140 | (t/deftest refined-with-open-closed-interval-predicate 141 | (ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 42) 142 | (ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 43) 143 | (ok! (r/refined double (r/OpenClosedInterval 0.0 1.0)) 0.7) 144 | (ok! (r/refined double (r/OpenClosedInterval 0.0 1.0)) 1.0) 145 | 146 | (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) -7) 147 | (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 108) 148 | (not-ok! (r/refined s/Int (r/OpenClosedInterval 0 43)) 0) 149 | (not-ok! (r/refined double (r/OpenClosedInterval 0.0 1.0)) 3.14) 150 | (not-ok! (r/refined double (r/OpenClosedInterval 0.0 1.0)) -3.14) 151 | (not-ok! (r/refined double (r/OpenClosedInterval 0.0 1.0)) 0.0)) 152 | 153 | (t/deftest refined-with-closed-open-interval-predicate 154 | (ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 42) 155 | (ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 0) 156 | (ok! (r/refined double (r/ClosedOpenInterval 0.0 1.0)) 0.7) 157 | (ok! (r/refined double (r/ClosedOpenInterval 0.0 1.0)) 0.0) 158 | 159 | (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) -7) 160 | (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 108) 161 | (not-ok! (r/refined s/Int (r/ClosedOpenInterval 0 43)) 43) 162 | (not-ok! (r/refined double (r/ClosedOpenInterval 0.0 1.0)) 3.14) 163 | (not-ok! (r/refined double (r/ClosedOpenInterval 0.0 1.0)) -3.14) 164 | (not-ok! (r/refined double (r/ClosedOpenInterval 0.0 1.0)) 1.0)) 165 | 166 | (t/deftest refined-with-even-predicate 167 | (ok! (r/refined s/Int r/Even) 108) 168 | 169 | (not-ok! (r/refined s/Int r/Even) 13)) 170 | 171 | (t/deftest refined-with-odd-predicate 172 | (ok! (r/refined s/Int r/Odd) 13) 173 | 174 | (not-ok! (r/refined s/Int r/Odd) 108)) 175 | 176 | (t/deftest refined-with-modulo-predicate 177 | (ok! (r/refined s/Int (r/Modulo 7 3)) 24) 178 | (ok! (r/refined s/Int (r/Modulo 7 3)) -25) 179 | 180 | (not-ok! (r/refined s/Int (r/Modulo 7 3)) 25) 181 | (not-ok! (r/refined s/Int (r/Modulo 7 3)) -24)) 182 | 183 | (t/deftest refined-with-divisible-by-predicate 184 | (ok! (r/refined s/Int (r/DivisibleBy 7)) 21) 185 | (ok! (r/refined s/Int (r/DivisibleBy 7)) -28) 186 | (ok! (r/refined s/Int (r/DivisibleBy 7)) 0) 187 | (ok! (r/refined s/Int (r/DivisibleBy 7)) 7) 188 | 189 | (not-ok! (r/refined s/Int (r/DivisibleBy 7)) 25) 190 | (not-ok! (r/refined s/Int (r/DivisibleBy 7)) -24)) 191 | 192 | (t/deftest refined-with-non-divisible-by-predicate 193 | (ok! (r/refined s/Int (r/NonDivisibleBy 7)) 25) 194 | (ok! (r/refined s/Int (r/NonDivisibleBy 7)) -24) 195 | 196 | (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 21) 197 | (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) -28) 198 | (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 0) 199 | (not-ok! (r/refined s/Int (r/NonDivisibleBy 7)) 7)) 200 | 201 | (t/deftest refined-with-starts-with-predicate 202 | (ok! (r/refined s/Str (r/StartsWith "https://")) "https://attendify.com") 203 | 204 | (not-ok! (r/refined s/Str (r/StartsWith "https://")) 205 | "ftp://attendify.com/long-file-name.txt")) 206 | 207 | (t/deftest refined-with-ends-with-predicate 208 | (ok! (r/refined s/Str (r/EndsWith ".com")) "https://attendify.com") 209 | 210 | (not-ok! (r/refined s/Str (r/EndsWith ".com")) 211 | "ftp://attendify.com/long-file-name.txt")) 212 | 213 | (t/deftest refined-with-includes-predicate 214 | (ok! (r/refined s/Str (r/Includes "attendify")) "https://attendify.com") 215 | 216 | (not-ok! (r/refined s/Str (r/Includes "attendify")) 217 | "https://example.com")) 218 | 219 | (t/deftest refined-with-lower-cased-predicate 220 | (ok! (r/refined s/Str r/LowerCased) "https://attendify.com") 221 | 222 | (not-ok! (r/refined s/Str r/LowerCased) "Hello")) 223 | 224 | (t/deftest refined-with-upper-cased-predicate 225 | (ok! (r/refined s/Str r/UpperCased) "ACE") 226 | 227 | (not-ok! (r/refined s/Str r/UpperCased) "https://attendify.com")) 228 | 229 | (t/deftest refined-with-empty-predicate 230 | (ok! (r/refined [s/Num] r/Empty) []) 231 | (ok! (r/refined [s/Num] r/Empty) '()) 232 | (ok! (r/refined s/Str r/Empty) "") 233 | (ok! (r/refined {s/Keyword s/Str} r/Empty) {}) 234 | 235 | (not-ok! (r/refined s/Str r/Empty) "doom") 236 | (not-ok! (r/refined [s/Num] r/Empty) [1 2 3]) 237 | (not-ok! (r/refined {s/Keyword s/Str} r/Empty) {:boom "Doom"}) 238 | (not-ok! (r/refined [s/Str] r/Empty) ["a" "b" "c"]) 239 | (not-ok! (r/refined [s/Any] r/Empty) [["a"] ["b" "c"] ["c" "d"]]) 240 | (not-ok! (r/refined s/Str r/Empty) nil) 241 | (not-ok! (r/refined s/Str r/Empty) '())) 242 | 243 | (t/deftest refined-with-not-empty-predicate 244 | (ok! (r/refined s/Str r/NonEmpty) "doom") 245 | (ok! (r/refined [s/Num] r/NonEmpty) [1 2 3]) 246 | (ok! (r/refined {s/Keyword s/Str} r/NonEmpty) {:boom "Doom"}) 247 | (ok! (r/refined [(r/refined s/Str r/NonEmpty)] r/NonEmpty) ["a" "b" "c"]) 248 | (ok! (r/refined [(r/refined [(r/refined s/Str r/NonEmpty)] r/NonEmpty)] r/NonEmpty) 249 | [["a"] ["b" "c"] ["c" "d"]]) 250 | 251 | (not-ok! (r/refined [s/Num] r/NonEmpty) []) 252 | (not-ok! (r/refined [s/Num] r/NonEmpty) '()) 253 | (not-ok! (r/refined s/Str r/NonEmpty) nil) 254 | (not-ok! (r/refined s/Str r/NonEmpty) '()) 255 | (not-ok! (r/refined s/Str r/NonEmpty) "") 256 | (not-ok! (r/refined {s/Keyword s/Str} r/NonEmpty) {})) 257 | 258 | (t/deftest refined-with-bounded-size-predicate 259 | (let [min-size 1 260 | max-size 3 261 | BoundedSize (r/BoundedSize min-size max-size)] 262 | (doseq [size (range min-size (inc max-size))] 263 | (ok! (r/refined [s/Num] BoundedSize) (range size)) 264 | (ok! (r/refined #{s/Num} BoundedSize) (set (range size))) 265 | (ok! (r/refined {s/Num s/Num} BoundedSize) (numeric-map size))) 266 | 267 | (not-ok! (r/refined [s/Num] BoundedSize) []) 268 | (not-ok! (r/refined #{s/Num} BoundedSize) #{}) 269 | (not-ok! (r/refined {s/Num s/Num} BoundedSize) {}) 270 | (not-ok! (r/refined [s/Num] BoundedSize) (range (inc max-size))) 271 | (not-ok! (r/refined #{s/Num} BoundedSize) (-> max-size inc range set)) 272 | (not-ok! (r/refined {s/Num s/Num} BoundedSize) (numeric-map (inc max-size))))) 273 | 274 | (t/deftest refined-with-distinct-predicate 275 | (ok! (r/refined [s/Num] r/Distinct) (range 7)) 276 | (ok! (r/refined [s/Num] r/Distinct) []) 277 | 278 | (not-ok! (r/refined [s/Num] r/Distinct) (repeat 7 1))) 279 | 280 | (t/deftest refined-with-distinct-by-predicate 281 | (ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) (map #(-> {:foo %}) (range 7))) 282 | (ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) []) 283 | 284 | (not-ok! (r/refined [{:foo s/Num}] (r/DistinctBy :foo)) 285 | (->> 1 286 | (repeat 7) 287 | (map #(-> {:foo %}))))) 288 | 289 | (t/deftest refined-with-forall-predicate 290 | (ok! (r/refined [s/Int] (r/Forall odd?)) (range 1 10 2)) 291 | (ok! (r/refined [s/Int] (r/Forall r/PositiveInt)) (range 1 10)) 292 | (ok! (r/refined [s/Str] (r/Forall r/Empty)) (repeat 10 "")) 293 | 294 | (not-ok! (r/refined [s/Int] (r/Forall odd?)) (range 1 10)) 295 | (not-ok! (r/refined [s/Int] (r/Forall r/PositiveInt)) (conj (range 1 10) -1)) 296 | (not-ok! (r/refined [s/Str] (r/Forall r/Empty)) (into (repeat 10 "") ["a" ""]))) 297 | 298 | (t/deftest refined-with-exists-predicate 299 | (ok! (r/refined [s/Int] (r/Exists odd?)) (into (range 0 10 2) [2 7 5])) 300 | (ok! (r/refined [s/Int] (r/Exists r/PositiveInt)) (into (range -10 -5) [-4 1 0])) 301 | (ok! (r/refined [s/Str] (r/Exists r/Empty)) (into (repeat 10 "a") ["a" "" "a"])) 302 | 303 | (not-ok! (r/refined [s/Int] (r/Exists odd?)) (range 0 10 2)) 304 | (not-ok! (r/refined [s/Int] (r/Exists r/PositiveInt)) (range -10 -5)) 305 | (not-ok! (r/refined [s/Str] (r/Exists r/Empty)) (repeat 10 "a"))) 306 | 307 | (t/deftest refined-with-first-predicate 308 | (ok! (r/refined [s/Int] (r/First odd?)) (conj (range 0 10 2) 1)) 309 | (ok! (r/refined [s/Int] (r/First r/PositiveInt)) (conj (range -10 -5) 1)) 310 | (ok! (r/refined [s/Str] (r/First r/Empty)) (conj (repeat 10 "a") "")) 311 | 312 | (not-ok! (r/refined [s/Int] (r/First odd?)) (into (range 0 10 2) [1 2])) 313 | (not-ok! (r/refined [s/Int] (r/First r/PositiveInt)) (into (range -10 -5) [1 -2])) 314 | (not-ok! (r/refined [s/Str] (r/First r/Empty)) (into (repeat 10 "a") ["" "a"]))) 315 | 316 | (t/deftest refined-with-second-predicate 317 | (ok! (r/refined [s/Int] (r/Second odd?)) (into (range 0 10 2) [1 2])) 318 | (ok! (r/refined [s/Int] (r/Second r/PositiveInt)) (into (range -10 -5) [1 -2])) 319 | (ok! (r/refined [s/Str] (r/Second r/Empty)) (into (repeat 10 "a") ["" "a"])) 320 | 321 | (not-ok! (r/refined [s/Int] (r/Second odd?)) (conj (range 0 10 2) 1)) 322 | (not-ok! (r/refined [s/Int] (r/Second r/PositiveInt)) (conj (range -10 -5) 1)) 323 | (not-ok! (r/refined [s/Str] (r/Second r/Empty)) (conj (repeat 10 "a") ""))) 324 | 325 | (t/deftest refined-with-index-predicate 326 | (ok! (r/refined [s/Int] (r/Index 2 odd?)) (into (range 0 10 2) [1 2 4])) 327 | (ok! (r/refined [s/Int] (r/Index 2 r/PositiveInt)) (into (range -10 -5) [1 -2 -3])) 328 | (ok! (r/refined [s/Str] (r/Index 2 r/Empty)) (into (repeat 10 "a") ["" "a" "a"])) 329 | 330 | (not-ok! (r/refined [s/Int] (r/Index 2 odd?)) (conj (range 0 10 2) 1)) 331 | (not-ok! (r/refined [s/Int] (r/Index 2 r/PositiveInt)) (conj (range -10 -5) 1)) 332 | (not-ok! (r/refined [s/Str] (r/Index 2 r/Empty)) (conj (repeat 10 "a") ""))) 333 | 334 | (t/deftest refined-with-rest-predicate 335 | (ok! (r/refined [s/Int] (r/Rest even?)) (conj (range 0 10 2) 1)) 336 | (ok! (r/refined [s/Int] (r/Rest r/NegativeInt)) (conj (range -10 -5) 1)) 337 | (ok! (r/refined [s/Str] (r/Rest r/NonEmpty)) (conj (repeat 10 "a") "")) 338 | 339 | (not-ok! (r/refined [s/Int] (r/Rest even?)) (into (range 0 10 2) [1 2])) 340 | (not-ok! (r/refined [s/Int] (r/Rest r/NegativeInt)) (into (range -10 -5) [1 -2])) 341 | (not-ok! (r/refined [s/Str] (r/Rest r/NonEmpty)) (into (repeat 10 "a") ["" "a"]))) 342 | 343 | (t/deftest refined-with-last-predicate 344 | (ok! (r/refined [s/Int] (r/Last odd?)) (conj (vec (range 0 10 2)) 1)) 345 | (ok! (r/refined [s/Int] (r/Last r/PositiveInt)) (conj (vec (range -10 -5)) 1)) 346 | (ok! (r/refined [s/Str] (r/Last r/Empty)) (conj (vec (repeat 10 "a")) "")) 347 | 348 | (not-ok! (r/refined [s/Int] (r/Last odd?)) (into (range 0 10 2) [1 2])) 349 | (not-ok! (r/refined [s/Int] (r/Last r/PositiveInt)) (into (range -10 -5) [1 -2])) 350 | (not-ok! (r/refined [s/Str] (r/Last r/Empty)) (into (repeat 10 "a") ["" "a"]))) 351 | 352 | (t/deftest refined-with-butlast-predicate 353 | (ok! (r/refined [s/Int] (r/Butlast even?)) (conj (vec (range 0 10 2)) 1)) 354 | (ok! (r/refined [s/Int] (r/Butlast r/NegativeInt)) (conj (vec (range -10 -5)) 1)) 355 | (ok! (r/refined [s/Str] (r/Butlast r/NonEmpty)) (conj (vec (repeat 10 "a")) "")) 356 | 357 | (not-ok! (r/refined [s/Int] (r/Butlast even?)) (into (range 0 10 2) [1 2])) 358 | (not-ok! (r/refined [s/Int] (r/Butlast r/NegativeInt)) (into (range -10 -5) [1 -2])) 359 | (not-ok! (r/refined [s/Str] (r/Butlast r/NonEmpty)) (into (repeat 10 "a") ["" "a"]))) 360 | 361 | (t/deftest refined-with-pairwise-predicate 362 | (let [sum-equals-3? (fn [[a b]] (= 3 (+ a b)))] 363 | (ok! (r/refined [s/Int] (r/Pairwise sum-equals-3?)) [1 2 1]) 364 | 365 | (not-ok! (r/refined [s/Int] (r/Pairwise sum-equals-3?)) [1 1]))) 366 | 367 | (t/deftest refined-with-ascending-on-predicate 368 | (ok! (r/refined [{:price s/Int}] (r/AscendingOn :price)) 369 | (map #(-> {:price %}) (range 10))) 370 | 371 | (not-ok! (r/refined [{:price s/Int}] (r/AscendingOn :price)) 372 | (conj (map #(-> {:price %}) (range 10)) {:price 5}))) 373 | 374 | (t/deftest refined-with-descending-on-predicate 375 | (ok! (r/refined [{:price s/Int}] (r/DescendingOn :price)) 376 | (map #(-> {:price %}) (range 10 0 -1))) 377 | 378 | (not-ok! (r/refined [{:price s/Int}] (r/DescendingOn :price)) 379 | (conj (map #(-> {:price %}) (range 10 0 -1)) {:price 5}))) 380 | 381 | (let [SponsorshipLevel (s/enum "bronze" "silver" "gold") 382 | better-sponsor? (fn [{a-level :level} {b-level :level}] 383 | (cond 384 | (= a-level b-level) 0 385 | (= a-level "bronze") -1 386 | (= b-level "gold") -1 387 | :else 1))] 388 | (t/deftest refined-with-ascending-by-predicate 389 | (ok! (r/refined [{:level SponsorshipLevel}] (r/AscendingBy better-sponsor?)) 390 | [{:level "bronze"} {:level "silver"} {:level "silver"} {:level "gold"}]) 391 | 392 | (not-ok! (r/refined [{:level SponsorshipLevel}] (r/AscendingBy better-sponsor?)) 393 | [{:level "bronze"} {:level "gold"} {:level "silver"}])) 394 | 395 | (t/deftest refined-with-descending-by-predicate 396 | (ok! (r/refined [{:level SponsorshipLevel}] (r/DescendingBy better-sponsor?)) 397 | [{:level "gold"} {:level "silver"} {:level "silver"} {:level "bronze"}]) 398 | 399 | (not-ok! (r/refined [{:level SponsorshipLevel}] (r/DescendingBy better-sponsor?)) 400 | [{:level "gold"} {:level "bronze"} {:level "silver"}]))) 401 | 402 | (t/deftest refined-with-ascending-predicate 403 | (ok! (r/refined [s/Int] r/Ascending) (range 10)) 404 | 405 | (not-ok! (r/refined [s/Int] r/Ascending) (conj (range 10) 5))) 406 | 407 | (t/deftest refined-with-descending-predicate 408 | (ok! (r/refined [s/Int] r/Descending) (range 10 0 -1)) 409 | 410 | (not-ok! (r/refined [{:price s/Int}] r/Descending) (conj (range 10 0 -1) 5)))) 411 | 412 | (t/deftest validate-empty-values 413 | (ok! r/EmptyList []) 414 | (ok! r/EmptyList '()) 415 | (ok! r/EmptyMap {}) 416 | 417 | (not-ok! r/EmptyList [1 2 3]) 418 | (not-ok! r/EmptyMap {:boom "Doom"}) 419 | (not-ok! r/EmptyList ["a" "b" "c"]) 420 | (not-ok! r/EmptyList [["a"] ["b" "c"] ["c" "d"]])) 421 | 422 | (t/deftest validate-non-empty-values 423 | (ok! r/NonEmptyStr "doom") 424 | (ok! (r/NonEmptyListOf s/Num) [1 2 3]) 425 | (ok! (r/NonEmptyMapOf s/Keyword s/Str) {:boom "Doom"}) 426 | (ok! (r/NonEmptyListOf r/NonEmptyStr) ["a" "b" "c"]) 427 | (ok! (r/NonEmptyListOf (r/NonEmptyListOf r/NonEmptyStr)) [["a"] ["b" "c"] ["c" "d"]]) 428 | (not-ok! (r/NonEmptyListOf s/Num) []) 429 | (not-ok! (r/NonEmptyListOf s/Num) '()) 430 | (not-ok! r/NonEmptyStr nil) 431 | (not-ok! r/NonEmptyStr '()) 432 | (not-ok! r/NonEmptyStr "") 433 | (not-ok! (r/NonEmptyMapOf s/Keyword s/Str) {})) 434 | 435 | (t/deftest validate-urls 436 | (ok! r/UriStr "https://attendify.com") 437 | (ok! r/UriStr "ftp://attendify.com/long-file-name.txt") 438 | (not-ok! r/UriStr "attendify com") 439 | 440 | (ok! r/UrlStr "https://attendify.com") 441 | (ok! r/UrlStr "ftp://attendify.com/long-file-name.txt") 442 | (ok! r/UrlStr "ftp://") 443 | (not-ok! r/UrlStr "attendify com")) 444 | 445 | (t/deftest range-length-string 446 | (ok! (r/BoundedSizeStr 1 10) "a") 447 | (ok! (r/BoundedSizeStr 1 10) "abcdeabcde") 448 | (ok! (r/BoundedSizeStr 1 10) "abcde ") 449 | (not-ok! (r/BoundedSizeStr 1 10) "") 450 | (not-ok! (r/BoundedSizeStr 1 10) "abcdeabcdeabcde") 451 | (not-ok! (r/BoundedSizeStr 1 10) "abcdeabcde ") 452 | (ok! (r/BoundedSizeStr 1 10 true) "abcdeabcde ") 453 | (not-ok! (r/BoundedSizeStr 1 10 true) " ")) 454 | 455 | (t/deftest validate-bounded-collections 456 | (let [min-size 1 457 | max-size 3] 458 | (doseq [size (range min-size (inc max-size))] 459 | (ok! (r/BoundedListOf s/Num min-size max-size) (range size)) 460 | (ok! (r/BoundedSetOf s/Num min-size max-size) (set (range size))) 461 | (ok! (r/BoundedMapOf s/Num s/Num min-size max-size) (numeric-map size))) 462 | 463 | (not-ok! (r/BoundedListOf s/Num min-size max-size) []) 464 | (not-ok! (r/BoundedSetOf s/Num min-size max-size) #{}) 465 | (not-ok! (r/BoundedMapOf s/Num s/Num min-size max-size) {}) 466 | (not-ok! (r/BoundedListOf s/Num min-size max-size) (range (inc max-size))) 467 | (not-ok! (r/BoundedSetOf s/Num min-size max-size) (-> max-size inc range set)) 468 | (not-ok! (r/BoundedMapOf s/Num s/Num min-size max-size) (numeric-map (inc max-size))) 469 | 470 | (ok! (r/BoundedListOf s/Num max-size) (range max-size)) 471 | (ok! (r/BoundedSetOf s/Num max-size) 472 | (set (range max-size))) 473 | (ok! (r/BoundedMapOf s/Num s/Num max-size) 474 | (->> max-size 475 | range 476 | (map-indexed vector) 477 | (into {}))) 478 | 479 | (doseq [size (conj (range max-size) (inc max-size))] 480 | (not-ok! (r/BoundedListOf s/Num max-size) (range size)) 481 | (not-ok! (r/BoundedSetOf s/Num max-size) (-> size range set)) 482 | (not-ok! (r/BoundedMapOf s/Num s/Num max-size) (numeric-map size))) 483 | 484 | (ok! (r/SingleValueListOf s/Num) [1]) 485 | (ok! (r/SingleValueSetOf s/Num) #{1}) 486 | (ok! (r/SingleValueMapOf s/Num s/Num) {1 1}) 487 | 488 | (doseq [size [0 2]] 489 | (not-ok! (r/BoundedListOf s/Num max-size) (range size)) 490 | (not-ok! (r/BoundedSetOf s/Num max-size) (-> size range set)) 491 | (not-ok! (r/BoundedMapOf s/Num s/Num max-size) (numeric-map size))))) 492 | 493 | (t/deftest validate-digit-char 494 | (doseq [i (range 10)] 495 | (ok! r/DigitChar (str i))) 496 | 497 | (not-ok! r/DigitChar "attendify.com") 498 | (not-ok! r/DigitChar "") 499 | (not-ok! r/DigitChar ".") 500 | (not-ok! r/DigitChar "j")) 501 | 502 | (t/deftest validate-ascii-letter-char 503 | (doseq [i (map char (range (int \a) (inc (int \z))))] 504 | (ok! r/ASCIILetterChar (str i))) 505 | (doseq [i (map char (range (int \A) (inc (int \Z))))] 506 | (ok! r/ASCIILetterChar (str i))) 507 | 508 | (not-ok! r/ASCIILetterChar "attendify.com") 509 | (not-ok! r/ASCIILetterChar "") 510 | (not-ok! r/ASCIILetterChar ".") 511 | (not-ok! r/ASCIILetterChar "7")) 512 | 513 | (t/deftest validate-ascii-letter-or-digit-char 514 | (doseq [i (map char (range (int \a) (inc (int \z))))] 515 | (ok! r/ASCIILetterOrDigitChar (str i))) 516 | (doseq [i (map char (range (int \A) (inc (int \Z))))] 517 | (ok! r/ASCIILetterOrDigitChar (str i))) 518 | (doseq [i (range 10)] 519 | (ok! r/ASCIILetterOrDigitChar (str i))) 520 | 521 | (not-ok! r/ASCIILetterOrDigitChar "attendify.com") 522 | (not-ok! r/ASCIILetterOrDigitChar "") 523 | (not-ok! r/ASCIILetterOrDigitChar ".")) 524 | 525 | (t/deftest validate-bit-char 526 | (ok! r/BitChar "0") 527 | (ok! r/BitChar "1") 528 | 529 | (not-ok! r/BitChar "attendify.com") 530 | (not-ok! r/BitChar "") 531 | (not-ok! r/BitChar ".") 532 | (not-ok! r/BitChar "j") 533 | (not-ok! r/BitChar "7")) 534 | 535 | (t/deftest validate-bit-str 536 | (ok! r/BitStr "0") 537 | (ok! r/BitStr "1") 538 | (ok! r/BitStr "0001") 539 | (ok! r/BitStr "101010") 540 | 541 | (not-ok! r/BitStr "attendify.com") 542 | (not-ok! r/BitStr " ") 543 | (not-ok! r/BitStr "000000200") 544 | (not-ok! r/BitStr "j") 545 | (not-ok! r/BitStr "1111 ")) 546 | 547 | (t/deftest validate-int-str 548 | (ok! r/IntStr "0") 549 | (ok! r/IntStr "3") 550 | (ok! r/IntStr "-401") 551 | (ok! r/IntStr "101410") 552 | (ok! r/IntStr "000000200") 553 | 554 | (not-ok! r/IntStr "attendify.com") 555 | (not-ok! r/IntStr " ") 556 | (not-ok! r/IntStr "j") 557 | (not-ok! r/IntStr "1111 ")) 558 | 559 | (t/deftest validate-float-str 560 | (ok! r/FloatStr "0") 561 | (ok! r/FloatStr "3.14") 562 | (ok! r/FloatStr "-123.203201") 563 | (ok! r/FloatStr "101410") 564 | (ok! r/FloatStr "1111 ") 565 | 566 | (not-ok! r/FloatStr "attendify.com") 567 | (not-ok! r/FloatStr " ") 568 | (not-ok! r/FloatStr "j") 569 | (not-ok! r/FloatStr "3_14")) 570 | 571 | (t/deftest validate-starts-with-str 572 | (ok! (r/StartsWithStr "https://") "https://attendify.com") 573 | 574 | (not-ok! (r/StartsWithStr "https://") "ftp://attendify.com/long-file-name.txt")) 575 | 576 | (t/deftest validate-ends-with-str 577 | (ok! (r/EndsWithStr ".com") "https://attendify.com") 578 | 579 | (not-ok! (r/EndsWithStr ".com") "ftp://attendify.com/long-file-name.txt")) 580 | 581 | (t/deftest validate-includes-str 582 | (ok! (r/IncludesStr "attendify") "https://attendify.com") 583 | 584 | (not-ok! (r/IncludesStr "attendify") "https://example.com")) 585 | 586 | (t/deftest validate-lower-cased-str 587 | (ok! r/LowerCasedStr "https://attendify.com") 588 | 589 | (not-ok! r/LowerCasedStr "Hello")) 590 | 591 | (t/deftest validate-upper-cased-str 592 | (ok! r/UpperCasedStr "ACE") 593 | 594 | (not-ok! r/UpperCasedStr "https://attendify.com")) 595 | 596 | (t/deftest validate-positive-numeric 597 | (ok! (r/PositiveOf s/Int) 42) 598 | (ok! r/PositiveInt 42) 599 | (ok! (r/PositiveOf double) 3.14) 600 | (ok! r/PositiveDouble 3.14) 601 | 602 | (not-ok! (r/PositiveOf s/Int) 0) 603 | (not-ok! r/PositiveInt 0) 604 | (not-ok! (r/PositiveOf s/Int) -7) 605 | (not-ok! r/PositiveInt -7) 606 | (not-ok! (r/PositiveOf double) -3.14) 607 | (not-ok! r/PositiveDouble -3.14)) 608 | 609 | (t/deftest validate-negative-numeric 610 | (ok! (r/NegativeOf s/Int) -42) 611 | (ok! r/NegativeInt -42) 612 | (ok! (r/NegativeOf double) -3.14) 613 | (ok! r/NegativeDouble -3.14) 614 | 615 | (not-ok! (r/NegativeOf s/Int) 0) 616 | (not-ok! r/NegativeInt 0) 617 | (not-ok! (r/NegativeOf s/Int) 7) 618 | (not-ok! r/NegativeInt 7) 619 | (not-ok! (r/NegativeOf double) 3.14) 620 | (not-ok! r/NegativeDouble 3.14)) 621 | 622 | (t/deftest validate-non-negative-numeric 623 | (ok! (r/NonNegativeOf s/Int) 42) 624 | (ok! r/NonNegativeInt 42) 625 | (ok! (r/NonNegativeOf double) 3.14) 626 | (ok! r/NonNegativeDouble 3.14) 627 | (ok! (r/NonNegativeOf s/Int) 0) 628 | (ok! r/NonNegativeInt 0) 629 | 630 | (not-ok! (r/NonNegativeOf s/Int) -7) 631 | (not-ok! r/NonNegativeInt -7) 632 | (not-ok! (r/NonNegativeOf double) -3.14) 633 | (not-ok! r/NonNegativeDouble -3.14)) 634 | 635 | (t/deftest validate-non-positive-numeric 636 | (ok! (r/NonPositiveOf s/Int) -42) 637 | (ok! r/NonPositiveInt -42) 638 | (ok! (r/NonPositiveOf double) -3.14) 639 | (ok! r/NonPositiveDouble -3.14) 640 | (ok! (r/NonPositiveOf s/Int) 0) 641 | (ok! r/NonPositiveInt 0) 642 | 643 | (not-ok! (r/NonPositiveOf s/Int) 7) 644 | (not-ok! r/NonPositiveInt 7) 645 | (not-ok! (r/NonPositiveOf double) 3.14) 646 | (not-ok! r/NonPositiveDouble 3.14)) 647 | 648 | (t/deftest validate-numeric-open-interval 649 | (ok! (r/OpenIntervalOf s/Int 0 43) 42) 650 | (ok! (r/OpenIntervalOf double 0.0 1.0) 0.7) 651 | (ok! (r/EpsilonOf s/Int 10 5) 10) 652 | (ok! (r/EpsilonOf s/Int 10 5) 13) 653 | (ok! (r/EpsilonOf s/Int 10 5) 7) 654 | 655 | (not-ok! (r/OpenIntervalOf s/Int 0 43) 0) 656 | (not-ok! (r/OpenIntervalOf s/Int 0 43) 43) 657 | (not-ok! (r/OpenIntervalOf s/Int 0 43) -7) 658 | (not-ok! (r/OpenIntervalOf s/Int 0 43) 108) 659 | (not-ok! (r/OpenIntervalOf double 0.0 1.0) 0.0) 660 | (not-ok! (r/OpenIntervalOf double 0.0 1.0) 1.0) 661 | (not-ok! (r/OpenIntervalOf double 0.0 1.0) 3.14) 662 | (not-ok! (r/OpenIntervalOf double 0.0 1.0) -3.14) 663 | (not-ok! (r/EpsilonOf s/Int 10 5) 5) 664 | (not-ok! (r/EpsilonOf s/Int 10 5) 15) 665 | (not-ok! (r/EpsilonOf s/Int 10 5) -7) 666 | (not-ok! (r/EpsilonOf s/Int 10 5) 108)) 667 | 668 | (t/deftest validate-numeric-closed-interval 669 | (ok! (r/ClosedIntervalOf s/Int 0 43) 42) 670 | (ok! (r/ClosedIntervalOf s/Int 0 43) 0) 671 | (ok! (r/ClosedIntervalOf s/Int 0 43) 43) 672 | (ok! (r/ClosedIntervalOf double 0.0 1.0) 0.7) 673 | (ok! (r/ClosedIntervalOf double 0.0 1.0) 0.0) 674 | (ok! (r/ClosedIntervalOf double 0.0 1.0) 1.0) 675 | 676 | (not-ok! (r/ClosedIntervalOf s/Int 0 43) -7) 677 | (not-ok! (r/ClosedIntervalOf s/Int 0 43) 108) 678 | (not-ok! (r/ClosedIntervalOf double 0.0 1.0) 3.14) 679 | (not-ok! (r/ClosedIntervalOf double 0.0 1.0) -3.14)) 680 | 681 | (t/deftest validate-numeric-open-closed-interval 682 | (ok! (r/OpenClosedIntervalOf s/Int 0 43) 42) 683 | (ok! (r/OpenClosedIntervalOf s/Int 0 43) 43) 684 | (ok! (r/OpenClosedIntervalOf double 0.0 1.0) 0.7) 685 | (ok! (r/OpenClosedIntervalOf double 0.0 1.0) 1.0) 686 | 687 | (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) -7) 688 | (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) 108) 689 | (not-ok! (r/OpenClosedIntervalOf s/Int 0 43) 0) 690 | (not-ok! (r/OpenClosedIntervalOf double 0.0 1.0) 3.14) 691 | (not-ok! (r/OpenClosedIntervalOf double 0.0 1.0) -3.14) 692 | (not-ok! (r/OpenClosedIntervalOf double 0.0 1.0) 0.0)) 693 | 694 | (t/deftest validate-numeric-closed-open-interval 695 | (ok! (r/ClosedOpenIntervalOf s/Int 0 43) 42) 696 | (ok! (r/ClosedOpenIntervalOf s/Int 0 43) 0) 697 | (ok! (r/ClosedOpenIntervalOf double 0.0 1.0) 0.7) 698 | (ok! (r/ClosedOpenIntervalOf double 0.0 1.0) 0.0) 699 | 700 | (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) -7) 701 | (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) 108) 702 | (not-ok! (r/ClosedOpenIntervalOf s/Int 0 43) 43) 703 | (not-ok! (r/ClosedOpenIntervalOf double 0.0 1.0) 3.14) 704 | (not-ok! (r/ClosedOpenIntervalOf double 0.0 1.0) -3.14) 705 | (not-ok! (r/ClosedOpenIntervalOf double 0.0 1.0) 1.0)) 706 | 707 | (t/deftest validate-distinct-list 708 | (ok! (r/DistinctListOf s/Num) (range 7)) 709 | (ok! (r/DistinctListOf s/Num) []) 710 | (ok! (r/NonEmptyDistinctListOf s/Num) (range 7)) 711 | 712 | (not-ok! (r/DistinctListOf s/Num) (repeat 7 1)) 713 | (not-ok! (r/NonEmptyDistinctListOf s/Num) [])) 714 | 715 | (t/deftest validate-at-least-map 716 | (ok! (r/AtLeastMap {:foo s/Int}) {:foo 1}) 717 | (ok! (r/AtLeastMap {:foo s/Int}) {:foo 1 :bar 2}) 718 | 719 | (not-ok! (r/AtLeastMap {:foo s/Int}) {}) 720 | (not-ok! (r/AtLeastMap {:foo s/Int}) {:bar 2})) 721 | 722 | (t/deftest validate-non-strict-map 723 | (ok! (r/NonStrictMap {:foo s/Int}) {:foo 1}) 724 | (ok! (r/NonStrictMap {:foo s/Int}) {}) 725 | 726 | (not-ok! (r/NonStrictMap {:foo s/Int}) {:foo 1 :bar 2}) 727 | (not-ok! (r/NonStrictMap {:foo s/Int}) {:bar 2})) 728 | 729 | (def -Ticket (r/Struct :id r/NonEmptyStr 730 | :rev r/NonEmptyStr 731 | :price (s/maybe s/Num) 732 | :paid? s/Bool)) 733 | 734 | (def Ticket 735 | (r/guard 736 | -Ticket 737 | '(:price :paid?) 738 | (fn [{:keys [paid? price]}] 739 | (or (false? paid?) 740 | (and (some? price) (< 0 price)))) 741 | 'paid-ticket-should-have-price)) 742 | 743 | (t/deftest struct-with-guards 744 | (ok! Ticket {:id "1" :rev "2" :paid? true :price 10}) 745 | (not-ok! Ticket {:id "1" :rev "2" :paid? true}) 746 | (not-ok! Ticket {:id "1" :rev "2" :paid? true :price nil}) 747 | (ok! (dissoc Ticket :id :rev) {:paid? true :price 10}) 748 | (not-ok! (dissoc Ticket :id :rev) {:paid? true :price nil}) 749 | (ok! (dissoc Ticket :price) {:id "1" :rev "2" :paid? true})) 750 | 751 | (def -BaseCode (r/map->struct {:id r/NonEmptyStr 752 | :rev r/NonEmptyStr 753 | :name r/NonEmptyStr})) 754 | 755 | ;; still struct 756 | (def UnlockCode (assoc -BaseCode 757 | :codeType (s/eq "unlock") 758 | :code r/NonEmptyStr)) 759 | 760 | ;; still struct 761 | (def DiscountCode (assoc -BaseCode 762 | :codeType (s/eq "discount") 763 | :discountPercent (r/ClosedIntervalOf int 0 100))) 764 | 765 | ;; should be converted to strct inside Dispatch 766 | (def SecretCode {:codeType (s/eq "secret") 767 | :noValues r/NonEmptyStr}) 768 | 769 | (def Code (r/StructDispatch 770 | :codeType 771 | "unlock" UnlockCode 772 | "discount" DiscountCode 773 | "secret" SecretCode 774 | "downstream" (r/StructDispatch 775 | :fromDownstream 776 | false {:fromDownstream (s/eq false)} 777 | true {:fromDownstream (s/eq true)}) 778 | "customSlice" (assoc (r/StructDispatch 779 | '(:name) 780 | (fn [{:keys [name]}] (inc (count name))) 781 | 1 {:name r/NonEmptyStr} 782 | 2 {:name r/NonEmptyStr}) 783 | :codeType 784 | (s/eq "customSlice")))) 785 | 786 | (def CounterWithElse (r/StructDispatch 787 | :num 788 | 1 {:num (s/eq 1)} 789 | 2 {:num (s/eq 2)} 790 | :else {:num s/Any})) 791 | 792 | (def CreateCodeRequest (dissoc Code :id :rev)) 793 | 794 | (t/deftest dispatch-struct 795 | (ok! CreateCodeRequest {:codeType "unlock" 796 | :name "First" 797 | :code "Boom!"}) 798 | (ok! CreateCodeRequest {:codeType "discount" 799 | :name "Second" 800 | :discountPercent (int 50)}) 801 | (ok! CreateCodeRequest {:codeType "secret" 802 | :noValues "It's a secret!"}) 803 | (not-ok! CreateCodeRequest {:id "1" 804 | :codeType "unlock" 805 | :name "Third" 806 | :code "Fail :("}) 807 | (not-ok! CreateCodeRequest {:codeType "unknown" 808 | :name "Would not work"}) 809 | 810 | (t/testing "dissoc from keys slice for top-level dispatch" 811 | (t/is (thrown? IllegalArgumentException (dissoc Code :codeType)))) 812 | 813 | (t/testing "dissoc from downstream slices" 814 | (t/is (thrown? IllegalArgumentException (dissoc Code :fromDownstream)))) 815 | 816 | (t/testing "dispatch with duplicated options" 817 | (t/is (thrown? IllegalArgumentException 818 | (r/StructDispatch 819 | :fromDownstream 820 | true {:fromDownstream (s/eq false)} 821 | true {:fromDownstream (s/eq true)})))) 822 | 823 | (t/testing "custom keys slice" 824 | (ok! CreateCodeRequest {:codeType "customSlice" 825 | :name "z"}) 826 | (not-ok! CreateCodeRequest {:codeType "customSlice" 827 | :name "zzzz"})) 828 | 829 | (t/testing "else branch" 830 | (ok! CounterWithElse {:num 1}) 831 | (ok! CounterWithElse {:num 2}) 832 | (ok! CounterWithElse {:num 100}))) 833 | 834 | ;; 835 | ;; check tough printing cases 836 | ;; 837 | 838 | (defn test-print! [schema pattern] 839 | (let [dv (pr-str schema)] 840 | (t/is (.contains dv pattern) pattern))) 841 | 842 | (t/deftest print-vector-values 843 | (test-print! (r/refined [double] (r/Greater 10)) "[double]") 844 | (test-print! (r/refined [s/Str] r/NonEmpty) "[string]") 845 | (test-print! (r/refined #{int} (r/On count (r/Less 10))) "#{int}") 846 | 847 | (test-print! (r/refined' double (r/Less 0)) "double") 848 | (test-print! (r/refined' [float] (r/On count (r/Greater 0))) "[float]") 849 | 850 | (let [Coord {:lat float :lng float} 851 | Route (r/refined' [Coord] (r/On count (r/GreaterOrEqual 2)))] 852 | (test-print! Route "[Coord]"))) 853 | -------------------------------------------------------------------------------- /src/schema_refined/core.clj: -------------------------------------------------------------------------------- 1 | (ns schema-refined.core 2 | (:require [schema.core :as s] 3 | [schema.spec.core :as schema-spec] 4 | [schema.spec.variant :as schema-variant] 5 | [schema.utils :as schema-utils] 6 | [clojure.string :as cstr]) 7 | (:refer-clojure :exclude [boolean?]) 8 | (:import (java.net URI URISyntaxException URL MalformedURLException))) 9 | 10 | ;; 11 | ;; helpers & basic definitions 12 | ;; 13 | 14 | (defn boolean? 15 | "Backported boolean? from Clojure 1.9" 16 | [x] 17 | (instance? Boolean x)) 18 | 19 | (defn starts-with? 20 | "True if s starts with substr. Backported from Clojure 1.8" 21 | [^CharSequence s ^String substr] 22 | (.startsWith (.toString s) substr)) 23 | 24 | (defn ends-with? 25 | "True if s ends with substr. Backported from Clojure 1.8" 26 | [^CharSequence s ^String substr] 27 | (.endsWith (.toString s) substr)) 28 | 29 | (defn includes? 30 | "True if s includes substr. Backported from Clojure 1.8" 31 | [^CharSequence s ^CharSequence substr] 32 | (.contains (.toString s) substr)) 33 | 34 | (defn schema? [dt] 35 | (satisfies? s/Schema dt)) 36 | 37 | (defprotocol Predicate 38 | (predicate-apply [this value])) 39 | 40 | (defprotocol PredicateShow 41 | (predicate-show [this sym])) 42 | 43 | (defn predicate? [p] 44 | (satisfies? Predicate p)) 45 | 46 | (defn schema->str [schema] 47 | {:pre [(schema? schema)]} 48 | (let [tag (:schema-refined.core/tag (meta schema))] 49 | (cond 50 | (some? tag) 51 | tag 52 | 53 | (identical? java.lang.String schema) 54 | "string" 55 | 56 | (and (vector? schema) 57 | (= 1 (count schema))) 58 | (format "[%s]" (schema->str (first schema))) 59 | 60 | (and (set? schema) 61 | (= 1 (count schema))) 62 | (format "#{%s}" (schema->str (first schema))) 63 | 64 | (fn? schema) 65 | (schema-utils/fn-name schema) 66 | 67 | :else 68 | (pr-str schema)))) 69 | 70 | (defn predicate->str 71 | ([pred] (predicate->str pred "v" false)) 72 | ([pred sym bounded?] 73 | {:pre [(predicate? pred)]} 74 | (let [pred-str (if (satisfies? PredicateShow pred) 75 | (predicate-show pred sym) 76 | (str pred))] 77 | (cond->> pred-str 78 | (and bounded? (not (starts-with? pred-str "("))) 79 | (format "(%s)"))))) 80 | 81 | (defn predicate-print-method [pred ^java.io.Writer writer] 82 | (.write writer (format "#Predicate{%s}" (predicate->str pred)))) 83 | 84 | (defrecord FunctionPredicate [pred] 85 | Predicate 86 | (predicate-apply [_ value] 87 | (pred value)) 88 | PredicateShow 89 | (predicate-show [_ sym] 90 | (format "(%s %s)" (schema-utils/fn-name pred) sym))) 91 | 92 | (defmethod print-method FunctionPredicate 93 | [rs ^java.io.Writer writer] 94 | (predicate-print-method rs writer)) 95 | 96 | (defrecord SchemaPredicate [schema] 97 | Predicate 98 | (predicate-apply [_ value] 99 | (nil? (s/check schema value))) 100 | PredicateShow 101 | (predicate-show [_ sym] 102 | (format "%s: %s" sym (schema->str schema)))) 103 | 104 | (defmethod print-method SchemaPredicate 105 | [rs ^java.io.Writer writer] 106 | (predicate-print-method rs writer)) 107 | 108 | (defrecord RefinedSchema [schema pred] 109 | s/Schema 110 | (spec [this] 111 | (schema-variant/variant-spec 112 | schema-spec/+no-precondition+ 113 | [{:schema schema}] 114 | nil 115 | (schema-spec/precondition 116 | this 117 | (partial predicate-apply pred) 118 | #(list (symbol (schema-utils/fn-name pred)) %)))) 119 | (explain [_] 120 | (list 'refined 121 | (s/explain schema) 122 | (symbol (schema-utils/fn-name pred))))) 123 | 124 | ;; Use common representation in the following format: 125 | ;; 126 | ;; #Refined{v: T | (P v)} 127 | ;; 128 | ;; where T is a type (schema) and (P v) is the respresentation of 129 | ;; appropriate predicate. 130 | (defmethod print-method RefinedSchema 131 | [^RefinedSchema rs ^java.io.Writer writer] 132 | (let [schema (:schema rs) 133 | f (format "#Refined{v: %s | %s}" 134 | (schema->str schema) 135 | (predicate->str (:pred rs)))] 136 | (.write writer f))) 137 | 138 | (defn coerce 139 | "Turn function or schema to appropriate predicates" 140 | [pred] 141 | {:pre [(or (predicate? pred) 142 | (ifn? pred) 143 | (schema? pred))]} 144 | (cond 145 | (predicate? pred) 146 | pred 147 | 148 | (schema? pred) 149 | (SchemaPredicate. pred) 150 | 151 | (ifn? pred) 152 | (FunctionPredicate. pred))) 153 | 154 | (defn refined 155 | "Takes type (schema) and a predicate, creating a type that 156 | should satisfy both basic type and predicate. Note, that predicate might be 157 | specified as Predicate (protocol), simple function from `dt` type 158 | to boolean or another type (schema)" 159 | [dt pred] 160 | {:pre [(schema? dt)]} 161 | (RefinedSchema. dt (coerce pred))) 162 | 163 | (defmacro refined' 164 | "Works the same way as `refined` but captures the representation of type given. 165 | Captured type name (tag) will be used for printing `RefinedSchema`, so you can 166 | make your types even more readable. See the example below: 167 | 168 | (def Coord {:lat (OpenClosedIntervalOf double -180.0 180.0) 169 | :lng (OpenClosedIntervalOf double -90.0 90.0)}) 170 | 171 | (def Route (refined' [Coord] (On count (GreaterOrEqual 2)))) 172 | 173 | In case you prints your type (e.g. in REPL) you get: 174 | 175 | core> Route 176 | #Refined{v: [Coord] | (count v) ≥ 2} 177 | 178 | Please note, that a lot of types would be printed fine w/o macro (like primitives, 179 | typed vectors and sets, functions, etc)" 180 | [dt pred] 181 | (let [tag (str dt)] 182 | `(let [tagged# (with-meta ~dt {:schema-refined.core/tag ~tag}) 183 | safe?# (identical? (class tagged#) (class ~dt))] 184 | (refined (if safe?# tagged# ~dt) ~pred)))) 185 | 186 | ;; 187 | ;; boolean operations 188 | ;; 189 | 190 | (defrecord NotPredicate [pred] 191 | Predicate 192 | (predicate-apply [_ value] 193 | (not (predicate-apply pred value))) 194 | PredicateShow 195 | (predicate-show [_ sym] 196 | (format "(not %s)" (predicate->str pred sym true)))) 197 | 198 | (defn Not [p] 199 | (NotPredicate. (coerce p))) 200 | 201 | (defmethod print-method NotPredicate 202 | [p ^java.io.Writer writer] 203 | (predicate-print-method p writer)) 204 | 205 | (defn child-predicates->str [parent-sym sym ps] 206 | (->> ps 207 | (map #(predicate->str % sym true)) 208 | (cstr/join " ") 209 | (format "(%s %s)" parent-sym))) 210 | 211 | (defrecord AndPredicate [ps] 212 | Predicate 213 | (predicate-apply [_ value] 214 | (every? #(predicate-apply % value) ps)) 215 | PredicateShow 216 | (predicate-show [_ sym] 217 | (child-predicates->str "and" sym ps))) 218 | 219 | (defn And 220 | "Creates predicate that ensures all predicates given are safisfied. 221 | In case only one predicate given returns coerced version w/o wrapping" 222 | [p1 & ps] 223 | (if (empty? ps) 224 | (coerce p1) 225 | (AndPredicate. (map coerce (cons p1 ps))))) 226 | 227 | (defmethod print-method AndPredicate 228 | [p ^java.io.Writer writer] 229 | (predicate-print-method p writer)) 230 | 231 | (defrecord OrPredicate [ps] 232 | Predicate 233 | (predicate-apply [_ value] 234 | (some? (some #(predicate-apply % value) ps))) 235 | PredicateShow 236 | (predicate-show [_ sym] 237 | (child-predicates->str "or" sym ps))) 238 | 239 | (defn Or 240 | "Creates the predicate that ensures at least one predicate is satisfied. 241 | In case only one predicate given returns coerced version w/o wrapping" 242 | [p1 & ps] 243 | (if (empty? ps) 244 | (coerce p1) 245 | (OrPredicate. (map coerce (cons p1 ps))))) 246 | 247 | (defmethod print-method OrPredicate 248 | [p ^java.io.Writer writer] 249 | (predicate-print-method p writer)) 250 | 251 | (defrecord OnPredicate [on-fn pred] 252 | Predicate 253 | (predicate-apply [_ value] 254 | (predicate-apply pred (on-fn value))) 255 | PredicateShow 256 | (predicate-show [_ sym] 257 | (let [sym' (format "(%s %s)" (schema-utils/fn-name on-fn) sym)] 258 | (predicate->str pred sym' false)))) 259 | 260 | (defn On 261 | "Creates the predicate to ensure that the result of applying function 262 | `on-fn` to the value satisfies the predicate `pred`" 263 | [on-fn pred] 264 | {:pre [(ifn? on-fn)]} 265 | (OnPredicate. on-fn (coerce pred))) 266 | 267 | (defmethod print-method OnPredicate 268 | [p ^java.io.Writer writer] 269 | (predicate-print-method p writer)) 270 | 271 | ;; 272 | ;; ordering predicates 273 | ;; 274 | 275 | (defrecord EqualPredicate [n] 276 | Predicate 277 | (predicate-apply [_ value] 278 | (= value n)) 279 | PredicateShow 280 | (predicate-show [_ sym] 281 | (format "%s = %s" sym n))) 282 | 283 | (defmethod print-method EqualPredicate 284 | [p writer] 285 | (predicate-print-method p writer)) 286 | 287 | (defn Equal 288 | "A value that must be = n" 289 | [n] 290 | (EqualPredicate. n)) 291 | 292 | (defrecord LessPredicate [n] 293 | Predicate 294 | (predicate-apply [_ value] 295 | (< value n)) 296 | PredicateShow 297 | (predicate-show [_ sym] 298 | (format "%s < %s" sym n))) 299 | 300 | (defmethod print-method LessPredicate 301 | [p writer] 302 | (predicate-print-method p writer)) 303 | 304 | (defn Less 305 | "A value that must be < n" 306 | [n] 307 | (LessPredicate. n)) 308 | 309 | (defrecord LessOrEqualPredicate [n] 310 | Predicate 311 | (predicate-apply [_ value] 312 | (<= value n)) 313 | PredicateShow 314 | (predicate-show [_ sym] 315 | (format "%s ≤ %s" sym n))) 316 | 317 | (defmethod print-method LessOrEqualPredicate 318 | [p writer] 319 | (predicate-print-method p writer)) 320 | 321 | (defn LessOrEqual 322 | "A value that must be < n" 323 | [n] 324 | (LessOrEqualPredicate. n)) 325 | 326 | (defrecord GreaterPredicate [n] 327 | Predicate 328 | (predicate-apply [_ value] 329 | (< n value)) 330 | PredicateShow 331 | (predicate-show [_ sym] 332 | (format "%s > %s" sym n))) 333 | 334 | (defmethod print-method GreaterPredicate 335 | [p writer] 336 | (predicate-print-method p writer)) 337 | 338 | (defn Greater 339 | "A value that must be > n" 340 | [n] 341 | (GreaterPredicate. n)) 342 | 343 | (defrecord GreaterOrEqualPredicate [n] 344 | Predicate 345 | (predicate-apply [_ value] 346 | (<= n value)) 347 | PredicateShow 348 | (predicate-show [_ sym] 349 | (format "%s ≥ %s" sym n))) 350 | 351 | (defmethod print-method GreaterOrEqualPredicate 352 | [p writer] 353 | (predicate-print-method p writer)) 354 | 355 | (defn GreaterOrEqual 356 | "A value that must be >= n" 357 | [n] 358 | (GreaterOrEqualPredicate. n)) 359 | 360 | (defrecord OpenIntervalPredicate [a b] 361 | Predicate 362 | (predicate-apply [_ value] 363 | (< a value b)) 364 | PredicateShow 365 | (predicate-show [_ sym] 366 | (format "%s ∈ (%s, %s)" sym a b))) 367 | 368 | (defn OpenInterval 369 | "a < value < b" 370 | [a b] 371 | {:pre [(< a b)]} 372 | (OpenIntervalPredicate. a b)) 373 | 374 | (defrecord ClosedIntervalPredicate [a b] 375 | Predicate 376 | (predicate-apply [_ value] 377 | (<= a value b)) 378 | PredicateShow 379 | (predicate-show [_ sym] 380 | (format "%s ∈ [%s, %s]" sym a b))) 381 | 382 | (defn ClosedInterval 383 | "a <= value <= b" 384 | [a b] 385 | {:pre [(<= a b)]} 386 | (ClosedIntervalPredicate. a b)) 387 | 388 | (defrecord OpenClosedIntervalPredicate [a b] 389 | Predicate 390 | (predicate-apply [_ value] 391 | (and (< a value) (<= value b))) 392 | PredicateShow 393 | (predicate-show [_ sym] 394 | (format "%s ∈ (%s, %s]" sym a b))) 395 | 396 | (defn OpenClosedInterval 397 | "a < value <= b" 398 | [a b] 399 | {:pre [(< a b)]} 400 | (OpenClosedIntervalPredicate. a b)) 401 | 402 | (defrecord ClosedOpenIntervalPredicate [a b] 403 | Predicate 404 | (predicate-apply [_ value] 405 | (and (<= a value) (< value b))) 406 | PredicateShow 407 | (predicate-show [_ sym] 408 | (format "%s ∈ [%s, %s)" sym a b))) 409 | 410 | (defn ClosedOpenInterval 411 | "a <= value < b" 412 | [a b] 413 | {:pre [(< a b)]} 414 | (ClosedOpenIntervalPredicate. a b)) 415 | 416 | (defn Epsilon [center radius] 417 | (OpenInterval (- center radius) (+ center radius))) 418 | 419 | ;; 420 | ;; numeric predicates 421 | ;; 422 | 423 | (def Even (FunctionPredicate. even?)) 424 | 425 | (def Odd (FunctionPredicate. odd?)) 426 | 427 | (defrecord ModuloPredicate [div o] 428 | Predicate 429 | (predicate-apply [_ value] 430 | (= o (mod value div))) 431 | PredicateShow 432 | (predicate-show [_ sym] 433 | (format "%s mod %s = %s" sym div o))) 434 | 435 | (defn Modulo 436 | "The value modulus by div = o" 437 | [div o] 438 | (ModuloPredicate. div o)) 439 | 440 | (defn DivisibleBy [n] 441 | (Modulo n 0)) 442 | 443 | (defn NonDivisibleBy [n] 444 | (Not (DivisibleBy n))) 445 | 446 | ;; 447 | ;; numeric types 448 | ;; 449 | 450 | (defn PositiveOf [dt] 451 | {:pre [(schema? dt)]} 452 | (refined dt (Greater 0))) 453 | 454 | (defn NegativeOf [dt] 455 | {:pre [(schema? dt)]} 456 | (refined dt (Less 0))) 457 | 458 | (defn NonNegativeOf [dt] 459 | {:pre [(schema? dt)]} 460 | (refined dt (GreaterOrEqual 0))) 461 | 462 | (defn NonPositiveOf [dt] 463 | {:pre [(schema? dt)]} 464 | (refined dt (LessOrEqual 0))) 465 | 466 | (def PositiveInt (PositiveOf s/Int)) 467 | 468 | (def NegativeInt (NegativeOf s/Int)) 469 | 470 | (def NonNegativeInt (NonNegativeOf s/Int)) 471 | 472 | (def NonPositiveInt (NonPositiveOf s/Int)) 473 | 474 | (def PositiveDouble (PositiveOf double)) 475 | 476 | (def NegativeDouble (NegativeOf double)) 477 | 478 | (def NonNegativeDouble (NonNegativeOf double)) 479 | 480 | (def NonPositiveDouble (NonPositiveOf double)) 481 | 482 | (defn EpsilonOf [dt center radius] 483 | {:pre [(schema? dt)]} 484 | (refined dt (Epsilon center radius))) 485 | 486 | ;; 487 | ;; ordering types 488 | ;; 489 | 490 | (defn OpenIntervalOf 491 | "a < value < b" 492 | [dt a b] 493 | {:pre [(schema? dt)]} 494 | (refined dt (OpenInterval a b))) 495 | 496 | (defn ClosedIntervalOf 497 | "a <= value <= b" 498 | [dt a b] 499 | {:pre [(schema? dt)]} 500 | (refined dt (ClosedInterval a b))) 501 | 502 | (defn OpenClosedIntervalOf 503 | "a < value <= b" 504 | [dt a b] 505 | {:pre [(schema? dt)]} 506 | (refined dt (OpenClosedInterval a b))) 507 | 508 | (defn ClosedOpenIntervalOf 509 | "a <= value < b" 510 | [dt a b] 511 | {:pre [(schema? dt)]} 512 | (refined dt (ClosedOpenInterval a b))) 513 | 514 | ;; 515 | ;; strings & chars 516 | ;; 517 | 518 | (def NonEmptyStr 519 | (refined s/Str (Not (FunctionPredicate. cstr/blank?)))) 520 | 521 | (defn BoundedSizeStr 522 | ([min max] (BoundedSizeStr min max false)) 523 | ([min max trimmed?] 524 | {:pre [(<= min max) 525 | (boolean? trimmed?)]} 526 | (let [count-chars (if-not trimmed? 527 | count 528 | #(count (cstr/trim %1)))] 529 | (refined s/Str (On count-chars (ClosedInterval min max)))))) 530 | 531 | (def DigitChar #"^[0-9]$") 532 | 533 | (def ASCIILetterChar #"^[a-zA-Z]$") 534 | 535 | (def ASCIILetterOrDigitChar #"^[0-9a-zA-Z]$") 536 | 537 | (def BitChar #"^[0|1]$") 538 | 539 | (def BitStr #"^[0|1]*$") 540 | 541 | (defn parsable-int? [s] 542 | (try 543 | (Integer/parseInt s) 544 | true 545 | (catch NumberFormatException _ false))) 546 | 547 | (def IntStr (refined NonEmptyStr parsable-int?)) 548 | 549 | (defn parsable-float? [s] 550 | (try 551 | (Float/parseFloat s) 552 | true 553 | (catch NumberFormatException _ false))) 554 | 555 | (def FloatStr (refined NonEmptyStr parsable-float?)) 556 | 557 | (defn parsable-uri? [uri] 558 | (try 559 | (URI. uri) 560 | true 561 | (catch URISyntaxException _ false))) 562 | 563 | (def Uri (FunctionPredicate. parsable-uri?)) 564 | 565 | (def UriStr (refined NonEmptyStr Uri)) 566 | 567 | (defn parsable-url? [url] 568 | (try 569 | (URL. url) 570 | true 571 | (catch MalformedURLException _ false))) 572 | 573 | (def Url (FunctionPredicate. parsable-url?)) 574 | 575 | (def UrlStr (refined NonEmptyStr Url)) 576 | 577 | ;; 578 | ;; string predicates 579 | ;; 580 | 581 | (defn StartsWith [prefix] 582 | (FunctionPredicate. #(starts-with? % prefix))) 583 | 584 | (defn StartsWithStr [prefix] 585 | (refined s/Str (StartsWith prefix))) 586 | 587 | (defn EndsWith [suffix] 588 | (FunctionPredicate. #(ends-with? % suffix))) 589 | 590 | (defn EndsWithStr [suffix] 591 | (refined s/Str (EndsWith suffix))) 592 | 593 | (defn Includes [substr] 594 | (FunctionPredicate. #(includes? % substr))) 595 | 596 | (defn IncludesStr [substr] 597 | (refined s/Str (Includes substr))) 598 | 599 | (def LowerCased 600 | (FunctionPredicate. #(= %1 (cstr/lower-case %1)))) 601 | 602 | (def LowerCasedStr 603 | (refined s/Str LowerCased)) 604 | 605 | (def UpperCased 606 | (FunctionPredicate. #(= %1 (cstr/upper-case %1)))) 607 | 608 | (def UpperCasedStr 609 | (refined s/Str UpperCased)) 610 | 611 | ;; 612 | ;; collection predicates 613 | ;; 614 | 615 | (def Empty 616 | (reify 617 | Predicate 618 | (predicate-apply [_ value] 619 | (empty? value)) 620 | PredicateShow 621 | (predicate-show [_ sym] 622 | (format "%s = ∅" sym)))) 623 | 624 | (def NonEmpty 625 | (reify 626 | Predicate 627 | (predicate-apply [_ value] 628 | (not (empty? value))) 629 | PredicateShow 630 | (predicate-show [_ sym] 631 | (format "%s ≠ ∅" sym)))) 632 | 633 | (defn BoundedSize [left right] 634 | {:pre [(integer? left) 635 | (integer? right) 636 | (pos? left) 637 | (pos? right)]} 638 | (On count (ClosedInterval left right))) 639 | 640 | (defrecord DistinctByPredicate [f] 641 | Predicate 642 | (predicate-apply [_ value] 643 | (or (empty? value) 644 | (apply distinct? (map f value)))) 645 | PredicateShow 646 | (predicate-show [_ sym] 647 | (if (= identity f) 648 | (format "(distinct? %s)" sym) 649 | (format "(distinct-by? %s %s)" (schema-utils/fn-name f) sym)))) 650 | 651 | (defmethod print-method DistinctByPredicate 652 | [p ^java.io.Writer writer] 653 | (predicate-print-method p writer)) 654 | 655 | (def Distinct 656 | (DistinctByPredicate. identity)) 657 | 658 | (defn DistinctBy [f] 659 | {:pre [(ifn? f)]} 660 | (DistinctByPredicate. f)) 661 | 662 | (defrecord ForallPredicate [pred] 663 | Predicate 664 | (predicate-apply [_ value] 665 | (every? (partial predicate-apply pred) value)) 666 | PredicateShow 667 | (predicate-show [_ sym] 668 | (let [sym' (str sym "'")] 669 | (format "∀%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) 670 | 671 | (defmethod print-method ForallPredicate 672 | [p ^java.io.Writer writer] 673 | (predicate-print-method p writer)) 674 | 675 | (defn Forall [p] 676 | (ForallPredicate. (coerce p))) 677 | 678 | (defrecord ExistsPredicate [pred] 679 | Predicate 680 | (predicate-apply [_ value] 681 | (not (nil? (some (partial predicate-apply pred) value)))) 682 | PredicateShow 683 | (predicate-show [_ sym] 684 | (let [sym' (str sym "'")] 685 | (format "∃%s ∊ %s: %s" sym' sym (predicate->str pred sym' false))))) 686 | 687 | (defmethod print-method ExistsPredicate 688 | [p ^java.io.Writer writer] 689 | (predicate-print-method p writer)) 690 | 691 | (defn Exists [p] 692 | (ExistsPredicate. (coerce p))) 693 | 694 | (defn First [p] 695 | (On first (coerce p))) 696 | 697 | (defn Second [p] 698 | (On second (coerce p))) 699 | 700 | (defrecord IndexPredicate [n pred] 701 | Predicate 702 | (predicate-apply [_ value] 703 | (predicate-apply pred (nth value n))) 704 | PredicateShow 705 | (predicate-show [_ sym] 706 | (let [sym' (str sym "'")] 707 | (format "%s = %s[%s]: %s" sym' sym n (predicate->str pred sym' false))))) 708 | 709 | (defmethod print-method IndexPredicate 710 | [p ^java.io.Writer writer] 711 | (predicate-print-method p writer)) 712 | 713 | (defn Index [n p] 714 | {:pre [(integer? n)]} 715 | (IndexPredicate. n (coerce p))) 716 | 717 | (defn Rest [p] 718 | (On rest (Forall p))) 719 | 720 | (defn Last [p] 721 | (On last (coerce p))) 722 | 723 | (defn Butlast [p] 724 | (On butlast (Forall p))) 725 | 726 | (defrecord PairwisePredicate [pred] 727 | Predicate 728 | (predicate-apply [_ value] 729 | (->> (map vector value (rest value)) 730 | (every? (partial predicate-apply pred)))) 731 | PredicateShow 732 | (predicate-show [_ sym] 733 | (let [sym' (format "[%s[i], %s[i+1]]" sym sym)] 734 | (format "∀i ∊ [0, (dec (count %s))): %s" 735 | sym 736 | (predicate->str pred sym' false))))) 737 | 738 | (defmethod print-method PairwisePredicate 739 | [p ^java.io.Writer writer] 740 | (predicate-print-method p writer)) 741 | 742 | (defn Pairwise [p] 743 | (PairwisePredicate. (coerce p))) 744 | 745 | ;; 746 | ;; more ordering predicates 747 | ;; 748 | 749 | (defn AscendingOn [f] 750 | {:pre [(ifn? f)]} 751 | (Pairwise (fn [[a b]] 752 | (<= (compare (f a) (f b)) 0)))) 753 | 754 | (defn DescendingOn [f] 755 | {:pre [(ifn? f)]} 756 | (Pairwise (fn [[a b]] 757 | (<= 0 (compare (f a) (f b)))))) 758 | 759 | (defn AscendingBy [f] 760 | {:pre [(ifn? f)]} 761 | (Pairwise #(<= (f (first %1) (second %1)) 0))) 762 | 763 | (defn DescendingBy [f] 764 | {:pre [(ifn? f)]} 765 | (Pairwise #(<= 0 (f (first %1) (second %1))))) 766 | 767 | (def Ascending 768 | (AscendingBy compare)) 769 | 770 | (def Descending 771 | (DescendingBy compare)) 772 | 773 | ;; 774 | ;; collection types 775 | ;; 776 | 777 | (def EmptyList (refined [] Empty)) 778 | 779 | (def EmptySet (refined #{} Empty)) 780 | 781 | (def EmptyMap (refined {} Empty)) 782 | 783 | (defn NonEmptyListOf [dt] 784 | {:pre [(schema? dt)]} 785 | (refined [dt] NonEmpty)) 786 | 787 | (defn NonEmptyMapOf [key-dt value-dt] 788 | {:pre [(schema? key-dt) 789 | (schema? value-dt)]} 790 | (refined {key-dt value-dt} NonEmpty)) 791 | 792 | (defn NonEmptySetOf [dt] 793 | {:pre [(schema? dt)]} 794 | (refined #{dt} NonEmpty)) 795 | 796 | (defn BoundedListOf 797 | ([dt size] (BoundedListOf dt size size)) 798 | ([dt left right] 799 | {:pre [(schema? dt) 800 | (<= 0 left right)]} 801 | (refined [dt] (BoundedSize left right)))) 802 | 803 | (defn BoundedSetOf 804 | ([dt size] (BoundedSetOf dt size size)) 805 | ([dt left right] 806 | {:pre [(schema? dt) 807 | (<= 0 left right)]} 808 | (refined #{dt} (BoundedSize left right)))) 809 | 810 | (defn BoundedMapOf 811 | ([key-dt value-dt size] (BoundedMapOf key-dt value-dt size size)) 812 | ([key-dt value-dt left right] 813 | {:pre [(schema? key-dt) 814 | (schema? value-dt) 815 | (<= 0 left right)]} 816 | (refined {key-dt value-dt} (BoundedSize left right)))) 817 | 818 | (defn SingleValueListOf [dt] 819 | {:pre [(schema? dt)]} 820 | (BoundedListOf dt 1)) 821 | 822 | (defn SingleValueSetOf [dt] 823 | {:pre [(schema? dt)]} 824 | (BoundedSetOf dt 1)) 825 | 826 | (defn SingleValueMapOf [key-dt value-dt] 827 | {:pre [(schema? key-dt) 828 | (schema? value-dt)]} 829 | (BoundedMapOf key-dt value-dt 1)) 830 | 831 | (defn DistinctListOf [dt] 832 | {:pre [(schema? dt)]} 833 | (refined [dt] Distinct)) 834 | 835 | (defn NonEmptyDistinctListOf [dt] 836 | {:pre [(schema? dt)]} 837 | (refined (DistinctListOf dt) NonEmpty)) 838 | 839 | ;; 840 | ;; maps 841 | ;; 842 | 843 | (defn AtLeastMap [dt] 844 | {:pre [(map? dt)]} 845 | (assoc dt s/Any s/Any)) 846 | 847 | (defn NonStrictMap [dt] 848 | {:pre [(map? dt)]} 849 | (->> dt 850 | (map 851 | (fn [[k v]] 852 | [(s/optional-key k) (s/maybe v)])) 853 | (into {}))) 854 | 855 | ;; 856 | ;; simple sum type 857 | ;; 858 | 859 | (defn dispatch-on 860 | "Define a conditional schema by specifying determinant function 861 | (most likely a keyword) followed by the list of potential values 862 | and appropriate schemas. Throws if the result of determinant 863 | function does not confirm any listed value (the same as conditional 864 | does when no match found). In case subtypes are maps, please consider 865 | using Struct and StructDispatch, that would give you flexibility to deal 866 | with constrains (guards). 867 | 868 | Last pair treats :else value the same way conditional does. 869 | Has optional last symbol parameter to be returned in error if none of 870 | conditions match. 871 | 872 | Quick example: 873 | 874 | (def Point (BoundedListOf double 2)) 875 | (def Dot (SingleValueListOf Point)) 876 | (def Line (BoundedListOf Point 2)) 877 | (def Triangle (s/constrained (BoundedListOf Point 3) #(not (singular? %)))) 878 | (def RandomShape (NonEmptyListOf Point)) 879 | 880 | (def Polygon 881 | (dispatch-on count 882 | 1 Dot 883 | 2 Line 884 | 3 Triangle 885 | :else RandomShape))" 886 | [key-fn & subtypes] 887 | {:pre [(not (empty? subtypes)) 888 | (or (even? (count subtypes)) 889 | (and (symbol? (last subtypes)) 890 | (>= (count subtypes) 3)))]} 891 | (let [pairs (partition 2 subtypes) 892 | [last-key last-type] (last pairs) 893 | all-pairs (concat (mapcat (fn [[value type]] 894 | [#(= value (key-fn %)) type]) 895 | (butlast pairs)) 896 | [(if (= :else last-key) 897 | :else 898 | #(= last-key (key-fn %))) 899 | last-type] 900 | (if (odd? (count subtypes)) 901 | [(last subtypes)] 902 | []))] 903 | (apply s/conditional all-pairs))) 904 | 905 | ;; 906 | ;; guarded structs 907 | ;; 908 | 909 | ;; based on potemkin's def-map-type 910 | (defprotocol RefinedMapType 911 | (empty* [m]) 912 | (get* [m k default]) 913 | (assoc* [m k v]) 914 | (dissoc* [m k]) 915 | (keys* [m]) 916 | (with-meta* [o mta]) 917 | (meta* [o])) 918 | 919 | (defmacro -def-map-type 920 | {:style/indent [2 :form :form [1]]} 921 | [name params & body] 922 | `(deftype ~name ~params 923 | schema_refined.core.RefinedMapType 924 | ~@body 925 | 926 | clojure.lang.MapEquivalence 927 | 928 | clojure.lang.IPersistentCollection 929 | (equiv [this# x#] 930 | (and (or (instance? java.util.Map x#) (map? x#)) 931 | (= x# (into {} this#)))) 932 | (cons [this# o#] 933 | (cond 934 | (map? o#) 935 | (reduce #(apply assoc %1 %2) this# o#) 936 | 937 | (instance? java.util.Map o#) 938 | (reduce #(apply assoc %1 %2) this# (into {} o#)) 939 | 940 | :else 941 | (if-let [[k# v#] (seq o#)] 942 | (assoc this# k# v#) 943 | this#))) 944 | 945 | clojure.lang.IObj 946 | (withMeta [this# m#] 947 | (schema-refined.core/with-meta* this# m#)) 948 | (meta [this#] 949 | (schema-refined.core/meta* this#)) 950 | 951 | clojure.lang.Counted 952 | (count [this#] 953 | (count (schema-refined.core/keys* this#))) 954 | 955 | clojure.lang.Seqable 956 | (seq [this#] 957 | (seq 958 | (map 959 | #(.entryAt this# %) 960 | (schema-refined.core/keys* this#)))) 961 | 962 | clojure.core.protocols.CollReduce 963 | (coll-reduce [this# f#] 964 | (reduce f# (seq this#))) 965 | (coll-reduce [this# f# v#] 966 | (reduce f# v# (seq this#))) 967 | 968 | clojure.lang.IHashEq 969 | (hasheq [this#] 970 | (hash-unordered-coll (or (seq this#) ()))) 971 | 972 | Object 973 | (hashCode [this#] 974 | (reduce 975 | (fn [acc# [k# v#]] 976 | (unchecked-add acc# (bit-xor (clojure.lang.Util/hash k#) 977 | (clojure.lang.Util/hash v#)))) 978 | 0 979 | (seq this#))) 980 | (equals [this# x#] 981 | (or (identical? this# x#) 982 | (and 983 | (or (instance? java.util.Map x#) (map? x#)) 984 | (= x# (into {} this#))))) 985 | (toString [this#] 986 | (str (into {} this#))) 987 | 988 | clojure.lang.ILookup 989 | (valAt [this# k#] 990 | (.valAt this# k# nil)) 991 | (valAt [this# k# default#] 992 | (schema-refined.core/get* this# k# default#)) 993 | 994 | clojure.lang.Associative 995 | (containsKey [this# k#] 996 | (contains? (.keySet this#) k#)) 997 | (entryAt [this# k#] 998 | (when (contains? (.keySet this#) k#) 999 | (clojure.lang.MapEntry. k# (get this# k#)))) 1000 | (assoc [this# k# v#] 1001 | (schema-refined.core/assoc* this# k# v#)) 1002 | (empty [this#] 1003 | (schema-refined.core/empty* this#)) 1004 | 1005 | java.util.Map 1006 | (get [this# k#] 1007 | (.valAt this# k#)) 1008 | (isEmpty [this#] 1009 | (empty? this#)) 1010 | (size [this#] 1011 | (count this#)) 1012 | (keySet [this#] 1013 | (set (schema-refined.core/keys* this#))) 1014 | (put [_ _ _] 1015 | (throw (UnsupportedOperationException.))) 1016 | (putAll [_ _] 1017 | (throw (UnsupportedOperationException.))) 1018 | (clear [_] 1019 | (throw (UnsupportedOperationException.))) 1020 | (remove [_ _] 1021 | (throw (UnsupportedOperationException.))) 1022 | (values [this#] 1023 | (->> this# seq (map second))) 1024 | (entrySet [this#] 1025 | (->> this# seq set)) 1026 | 1027 | java.util.Iterator 1028 | (iterator [this#] 1029 | (clojure.lang.SeqIterator. this#)) 1030 | 1031 | clojure.lang.IPersistentMap 1032 | (assocEx [this# k# v#] 1033 | (if (contains? this# k#) 1034 | (throw (Exception. "Key or value already present")) 1035 | (assoc this# k# v#))) 1036 | (without [this# k#] 1037 | (schema-refined.core/dissoc* this# k#)) 1038 | 1039 | clojure.lang.IFn 1040 | (invoke [this# k#] (get this# k#)) 1041 | (invoke [this# k# not-found#] (get this# k# not-found#)))) 1042 | 1043 | (defprotocol Guardable 1044 | (append-guard [this guard]) 1045 | (get-guards [this])) 1046 | 1047 | (defn cleanup-guards [guards k] 1048 | (remove #(contains? (:slice-set %) k) guards)) 1049 | 1050 | (-def-map-type StructMap [data guards mta] 1051 | (empty* [_] (StructMap. {} [] {})) 1052 | (get* [_ k default-value] (get data k default-value)) 1053 | (assoc* [_ k v] (StructMap. (assoc data k v) guards mta)) 1054 | (dissoc* [_ k] (StructMap. (dissoc data k) (cleanup-guards guards k) mta)) 1055 | (keys* [_] (keys data)) 1056 | (meta* [_] mta) 1057 | (with-meta* [_ m] (StructMap. data guards m))) 1058 | 1059 | (extend-type StructMap 1060 | Guardable 1061 | (append-guard [^StructMap this guard] 1062 | (StructMap. (.data this) (conj (.guards this) guard) (.mta this))) 1063 | (get-guards [^StructMap this] (.guards this)) 1064 | s/Schema 1065 | (spec [this] this) 1066 | (explain [^StructMap this] 1067 | (cons 'guarded-struct (map s/explain (.data this)))) 1068 | schema-spec/CoreSpec 1069 | (subschemas [^StructMap this] 1070 | [(.data this)]) 1071 | (checker [^StructMap this params] 1072 | (fn [x] 1073 | (let [main-checker (schema-spec/sub-checker {:schema (.data this)} params) 1074 | tx (main-checker x)] 1075 | (if (schema-utils/error? tx) 1076 | tx 1077 | (reduce (fn [_ {:keys [slice guard name]}] 1078 | (let [x' (select-keys x slice) 1079 | next-schema (s/pred guard (or name 'not-complaint-with-guard)) 1080 | checker (schema-spec/sub-checker {:schema next-schema} params) 1081 | tx' (checker x')] 1082 | (when (schema-utils/error? tx') 1083 | (reduced tx')))) 1084 | nil 1085 | (get-guards this))))))) 1086 | 1087 | (defn guards->str [guards] 1088 | (if (empty? guards) 1089 | "" 1090 | (->> guards 1091 | (map (fn [{:keys [name slice]}] 1092 | (format " <%s> over %s" name (pr-str slice)))) 1093 | (cstr/join "\n") 1094 | (format "\n Guarded with\n%s")))) 1095 | 1096 | (defmethod print-method StructMap 1097 | [^StructMap struct ^java.io.Writer writer] 1098 | (let [all-guards (get-guards struct) 1099 | f (format "#" 1100 | (.data struct) 1101 | (guards->str all-guards))] 1102 | (.write writer f))) 1103 | 1104 | (defn map->struct [data] 1105 | (StructMap. data [] nil)) 1106 | 1107 | (defn Struct 1108 | "Defines map-like schema that you can further restrict with guards still having 1109 | the flexibility to add new fields or remove existing." 1110 | [& key-values] 1111 | {:pre [(even? (count key-values))]} 1112 | (map->struct (apply hash-map key-values))) 1113 | 1114 | (defn guard 1115 | "Restrict given Struct or StructDispatch the same way s/contrained does, but gives you 1116 | flexibility to transform structs whenever necessary by adding or removing fields (using 1117 | `assoc` and `dissoc` as you would do with the plain map). Note, that `dissoc` 1118 | operation cleans up guard when key under the question is mentioned in `keys-slice` 1119 | (that's actually the only reason you need to specify a slice of keys in advance, 1120 | as there is no way to compute them prior to executing checker function)." 1121 | ([struct keys-slice guard-fn] 1122 | (guard struct keys-slice guard-fn nil)) 1123 | ([struct keys-slice guard-fn guard-name] 1124 | {:pre [(satisfies? Guardable struct) 1125 | (ifn? guard-fn) 1126 | (not (empty? keys-slice)) 1127 | (or (nil? guard-name) (symbol? guard-name))]} 1128 | (let [new-guard {:slice keys-slice 1129 | :slice-set (set keys-slice) 1130 | :guard guard-fn 1131 | :name guard-name}] 1132 | (append-guard struct new-guard)))) 1133 | 1134 | (defn apply-struct-updates-to [updates base] 1135 | (reduce 1136 | (fn [state [op & args]] 1137 | (case op 1138 | :assoc (assoc state (first args) (second args)) 1139 | :dissoc (dissoc state (first args)))) 1140 | base 1141 | updates)) 1142 | 1143 | (defn append-guards-to [guards schema] 1144 | (reduce 1145 | (fn [state guard] 1146 | (append-guard state guard)) 1147 | schema 1148 | guards)) 1149 | 1150 | (-def-map-type StructDispatchMap [keys-slice 1151 | downstream-slice 1152 | dispatch-fn 1153 | options 1154 | guards 1155 | updates 1156 | mta] 1157 | (empty* [_] (StructDispatchMap. [] [] (constantly ::empty) [[::empty {}]] [] [] nil)) 1158 | (get* [_ k default-value] (get (apply-struct-updates-to updates {}) k default-value)) 1159 | (assoc* [_ k v] (StructDispatchMap. 1160 | keys-slice 1161 | downstream-slice 1162 | dispatch-fn 1163 | options 1164 | guards 1165 | (conj updates [:assoc k v]) 1166 | mta)) 1167 | (dissoc* [_ k] 1168 | (cond 1169 | (contains? keys-slice k) 1170 | (throw (IllegalArgumentException. 1171 | (str "You are trying to dissoc key '" 1172 | k 1173 | "' that is used in dispatch function. " 1174 | "Even tho' it's doable theoratically, we are kindly encourage you " 1175 | "avoid such kind of manipulations. It's gonna be a mess."))) 1176 | 1177 | (contains? downstream-slice k) 1178 | (throw (IllegalArgumentException. 1179 | (str "Meh. Would not work. One of the options provided actually " 1180 | "relies on the key '" k "'. Sorry, but I cannot take a risk here."))) 1181 | 1182 | :else 1183 | (StructDispatchMap. 1184 | keys-slice 1185 | downstream-slice 1186 | dispatch-fn 1187 | options 1188 | guards 1189 | (conj updates [:dissoc k]) 1190 | mta))) 1191 | (keys* [_] (keys (apply-struct-updates-to updates {}))) 1192 | (meta* [_] mta) 1193 | (with-meta* [_ m] (StructDispatchMap. 1194 | keys-slice 1195 | downstream-slice 1196 | dispatch-fn 1197 | options 1198 | guards 1199 | updates 1200 | m))) 1201 | 1202 | (defmethod print-method StructDispatchMap 1203 | [^StructDispatchMap struct ^java.io.Writer writer] 1204 | (let [options (->> (.options struct) 1205 | (map (fn [[value option]] 1206 | (format " %s => %s" value option))) 1207 | (cstr/join "\n")) 1208 | all-guards (get-guards ^Guardable struct) 1209 | guarded (guards->str all-guards) 1210 | f (format "#" 1211 | (.dispatch-fn struct) 1212 | options 1213 | guarded)] 1214 | (.write writer f))) 1215 | 1216 | (extend-type StructDispatchMap 1217 | Guardable 1218 | (append-guard [^StructDispatchMap this guard] 1219 | (StructDispatchMap. 1220 | (.keys-slice this) 1221 | (.downstream-slice this) 1222 | (.dispatch-fn this) 1223 | (.options this) 1224 | (conj (.guards this) guard) 1225 | (.updates this) 1226 | (.mta this))) 1227 | (get-guards [^StructDispatchMap this] (.guards this)) 1228 | s/Schema 1229 | (spec [this] this) 1230 | (explain [^StructDispatchMap this] 1231 | (cons 'struct-dispatch (map s/explain (map second (.options this))))) 1232 | schema-spec/CoreSpec 1233 | (subschemas [^StructDispatchMap this] 1234 | (map second (.options this))) 1235 | (checker [^StructDispatchMap this params] 1236 | (fn [x] 1237 | (let [dispatch-value ((.dispatch-fn this) (select-keys x (.keys-slice this))) 1238 | dispatch-schema (or (->> (.options this) 1239 | (filter #(= dispatch-value (first %))) 1240 | first) 1241 | ;; use `:else` branch when set 1242 | (let [[k v] (last (.options this))] 1243 | (when (= :else k) [:else v])))] 1244 | (if (nil? dispatch-schema) 1245 | (schema-utils/error (format "Dispatch value '%s' not found among options %s" 1246 | dispatch-value 1247 | (mapv first (.options this)))) 1248 | (let [dispatch-schema' (->> dispatch-schema 1249 | second 1250 | (append-guards-to (get-guards this)) 1251 | (apply-struct-updates-to (.updates this))) 1252 | checker (schema-spec/sub-checker {:schema dispatch-schema'} params)] 1253 | (checker x))))))) 1254 | 1255 | (defn StructDispatch 1256 | "Works the same way as `dispatch-on` but creates a data structure similar to struct 1257 | that might be updated with assoc/dissoc and guarded using `guard` function to created 1258 | delayed contrains. 1259 | 1260 | If dispatch function is not a keyword (read 'field') you need to specify keys slice 1261 | to prevent dissoc fields necessary to make a dispatch further. Each suboption should be 1262 | either map, StructMap or StructDispatch, map would be converted to Struct. 1263 | 1264 | Putting last option with ':else' as a dispatch result would match anything if the 1265 | appropriate value was not found earlier." 1266 | [& args] 1267 | (let [fa (first args) 1268 | [keys-slice dispatch-fn rest-args] 1269 | (if (keyword? fa) 1270 | [(set [fa]) fa (rest args)] 1271 | [(set fa) (second args) (drop 2 args)])] 1272 | (when (empty? rest-args) 1273 | (throw (IllegalArgumentException. "no options provided"))) 1274 | 1275 | (when (odd? (count rest-args)) 1276 | (throw (IllegalArgumentException. "dispatch argument could not be paired"))) 1277 | 1278 | (let [options (->> rest-args 1279 | (partition 2) 1280 | (map (fn [[k v]] 1281 | (cond 1282 | (instance? StructDispatchMap v) [k v] 1283 | (instance? StructMap v) [k v] 1284 | (map? v) [k (map->struct v)] 1285 | (satisfies? s/Schema v) [k v] 1286 | :else (throw 1287 | (IllegalArgumentException. 1288 | (format (str "Invalid dispatch subtype given for <%s>: %s\n" 1289 | "Should be one of the following: " 1290 | "StructMap, StructDispatch, map or any Schema") 1291 | k 1292 | v))))))) 1293 | overlap (->> options 1294 | (map first) 1295 | (frequencies) 1296 | (filter (fn [[k n]] (< 1 n))) 1297 | (map first)) 1298 | _ (when-not (empty? overlap) 1299 | (throw 1300 | (IllegalArgumentException. 1301 | (format "Some of the dispatch options listed more than once: %s" 1302 | overlap)))) 1303 | downstream-slice (->> options 1304 | (mapcat (fn [[k v]] 1305 | (if-not (instance? StructDispatchMap v) 1306 | [] 1307 | (into (.keys-slice ^StructDispatchMap v) 1308 | (.downstream-slice ^StructDispatchMap v))))) 1309 | (set))] 1310 | (StructDispatchMap. keys-slice downstream-slice dispatch-fn options [] [] nil)))) 1311 | --------------------------------------------------------------------------------